      PROGRAM CADX
C
C-------------------------------------------------------------------------
C
C   Executive routine for program CADAC, Version 3.0  Date: June 2000
C
C
C--Program History--------------------------------------------------------
C
C  2000 Jun   Version update to coincide with new CADAC Studio
C
C  2000 Feb   Eliminated the MINIT variable in C(1600) to be greater than 99 
C             for SWEEP cases.  In order to signal a SWEEP execution, a
C             SWEEP/NOSWEEP item must be added to the HEAD.ASC header.
C
C             Added error handler routine when reading CADIN.ASC file.
C             This alerts the user to the error record in the CADIN.ASC
C             file.  This routine also allows for full line comment records
C             indicated by the 04 in columns 1 and 2.
C             Subroutines changed: RDI1_PRIM_TRAJ
C                                  RDI1_16CARD
C                                  RDI2_RDCARD
C                                  SAV_INSTREAM
C
C  1999 Jun   Added a flag reset for reading from CSAVE.ASC file.  When the
C             run number flag, JRUN, is reset to 1 at the end of a multi-run
C             case, the ISAVE flag is also reset to indicate the start of
C             a new group trajectory.
C
C  1998 Sep   Default the CRITMAX value to zero unless CRITMAX enterd as
C             greater than CRITVAL.  This is will allow the SWEEP program
C             to pick up the T values as designated by TRCOND.
C
C             The critical variable output has been fixed with respect to 
C             output on TABOUT.  If the SWEEP trajectory does not reach the
C             correct end (LCONV > 2) the CritMax value is written as the 
C             critical variable value.
C
C             The test for the critical variable has been modified with respect
C             to the SWEEP modes.  The criteria testing starts with the 
C             critical variable being less than the critical value.  This is
C             true for SWEEP modes 4 and 5 only.
C
C  1998 May   Removed the FUNCTION RANF to be kept in the UTL2.FOR file.
C
C             Changed the Unit ID for TABOUT back to 6 such that all output
C             will written to standard output or TABOUT only.  Using the
C             Digital FORTRAN compiler, all output will be written to
C             TABOUT if indicated by TABOUTASC keyword in the HEAD.ASC file
C             All output will be written to the screen by default if no TABOUT
C             file indicated.
C
C  1998 Apr   Added call to SWEEPI in subroutine AUXI for SWEEP initialization
C
C             Changed the Unit ID for the TABOUT (tabular output) file
C             from 6 to 8.  This change will allow data to be written to
C             tabout and the screen during CADAC executions.  This change was
C             brought about when using the Digital Visual FORTRAN v5.0A.
C             Previous versions of Microsoft FORTRAN allowed writing to unit 6
C             as a file and writing to * for screen output; this was not supported 
C             in Digital's FORTRAN compiler.
C
C
C  1997 Sep   New output files created for use with the Real-Time CADAC
C             with associated file ids and flags.
C
C             New HEADER flags (for RT-CADAC) on the HEAD.ASC file:
C                 (NO)INITASC/(NO)INITBIN    Flags for RT initialization file
C                 (NO)TRACKASC/(N0)TRACKBIN  Flags for RT Track data file
C
C             New File IDS (for RT CADAC):
C                 ID_INITASC   - file ID for INIT.ASC  = 50
C                 ID_INITBIN   - file ID for INIT.BIN  = 51
C                 ID_TRACKASC  - file ID for TRACK.ASC = 60
C                 ID_TRACKBIN  - file ID for TRACK.BIN = 61
C
C             New output data files (for RT CADAC):
C                 INIT.ASC  - ascii RT initialization data file
C                 INIT.BIN  - binary RT initialization data file
C                 TRACK.BIN - ascii RT track data file
C                 TRACK.BIN - binary RT track data file
C
C             The read header plot variable routine (RDH1_PVAR) was 
C             changed to incorporate the new column 1 values.
C             Column 1 is now to indicate if the variable on that record
C             will be used for the RT CADAC output files generated by CADAC.
C             An I in column 1 indicates the variable is to be used for the
C             initialization file (INIT.ASC/BIN).  A T indicates the 
C             variable will be used for the track data file (TRACK.ASC/BIN).
C             A B indicates the variable will be used for both RT files.  
C             The * comment record is maintained.
C
C             A new COMMON was added to send the First Time Write Flag to the
C             INIT.ASC/BIN file
C             COMMOM /FIRSTI/ FINIT (Logical)
C
C  1997 May   New Sweep methodology added: SWEEP5. This methodology now
C             records impact information for a complete miss and
C             performs a binary search as the trajectories are
C             generated.  This new method is not fully checked out at this
C             time and therefore, SWEEP5 is a beta release.
C
C             LCONV = 5 for end of trajectory by staging - set in STGE3
C
C             SWEEP.ASC   renamed to IMPACT.ASC
C             SWEEP7.ASC  renamed to IMPACT7.ASC
C             SWEEP10.ASC renamed to IMPACT10.ASC
C             ID_SWEEP    renamed to ID_IMPACT
C             ID_SWEEP7   renamed to ID_IMPACT7
C             ID_SWEEP10  renamed to ID_IMPACT10
C
C             For SWEEP mode 4 and 5 impact data is written to IMPACT.ASC
C             file for all trajectories, either "hit" or "miss".  For 
C             "miss" trajectories, the critical value is replaced by 
C             CRITMAX and this new value is written to output files.
C
C  1995 Mar   Program converted to MS F32 and the files were renamed
C             The program was renamed to CADX1.  Additional output
C             options were added to the first line of the HEAD.ASC
C             file:  TRAJBIN, NOTRAJBIN, TRAJASC, NOTRAJASC, STATBIN,
C             NOSTATBIN, STATASC, NOSTATASC, TABOUT, NOTABOUT.  In
C             addition, file unit numbers were changed to variables.
C
C  1993       Program converted to PC.
C             These modifications necessary to the conversion included:
C             *   Changing the tabout unit to standard output for file
C                 redirection control by the batch file.  Modifying the
C                 open statements to access Environment Variables 
C                 instead of Logicals.
C             *   PC Version - this version corresponds to 
C                 CADAC_EXEC2_6.FOR on the
C                 VAX for use with MS F32.
C
C  Aug 93     A problem was discovered with the RANSEED methodology.  
C             Since the data is read from the input deck with a real number
C             and VAX real only keeps 7 sig digits, any seeds with more 
C             than 7 digits could not be accurately/easily entered.
C             The code was modified to allow the user to enter the most 
C             sig. 7 digits and add "01" as the least sig digits.  This
C             generated mods to options 1-3 of the RANSEED card entry.
C
C  XR 92      Modified the sweep methodology to allow multi-control 
C             cards to be used with the sweep cards (ie. type 90, and 5) 
C             NOTE: group cards were determined to be inappropriate when 
C             used with sweep cards.  
C             Test cases for 11 combinations were created and used
C             to test the valid methodology combinations with control 
C             cards.
C             Also performed:
C             *  Modified the OPNORO flag and WEII3 variable assignment.
C                Default is OPNORO=0 => rotating earth model;
C             *  Insured that the EXEC code was compatible with EQSORT
C             *  Performed further code cleanup (removed LSTEP from 
C                Exec); added more code comments.
C             *  Re-worked RANSEED initialization methodology to allow
C                single trajectories from multi-run cases to be 
C                executed without executing the entire run set.
C             *  Discovered a problem with the RANF function on the 
C                MicroVax so replaced system RANF with an inline module
C                that is based on the Fortran Intrinsic function RAN.
C                RANF provides uniform random values between (0,1), 
C                exclusive of both 0 and 1.
C             *
C
C  SEU 91-08  Executive code updated.  Final version named CADAC_EXEC1.
C             Code updated documented in ER-TC-SEU 91-08, 
C             PROGRAM CADAC: UPGRADE 1
C             Modifications included:
C             *  Futher comments added and code sturcturing performed.
C             *  All output/input files opened using logicals but also
C                have default names when logicals undefined.
C             *  Sweep modules were restructured and commented to allow 
C                more flexibility.  Options for the sweep searchings 
C                methodology were commented and corrected as needed.  
C                Operations were verified.  Card types changed to 19, 
C                20 and 21
C             *  A methodology for defining vectors in the C array was
C                implemented as well as the type 7 card for initializing
C                the vector
C             *  Warning messages were added to the modified Euler 
C                integration module, AMRK.
C             *  Type 4 card added - comment card.
C
C  SEU 91-02  Executive received from Dr. Zipfel.  The executive was 
C             utilized in the task and the following modifications 
C             were performed:
C             *  Structured code elements were substituded for 
C                non-structured code elements where applicable
C             *  Comments were added
C             *  Code was broken into modules
C             *  Head.ASC (unit 3) was opened with "readonly" status
C             *  RANSEED variable was added for initialization of random 
C                function generator and code to perform the 
C                initialization was added to the exec.
C             *  RAYLE, RAYLEI, EXPO and SIGN functions added to type 11 
C                and type 3 cards.
C
C  NOTE:  The cadac executive prints whatever values are in the C location
C         to the trajectory and statistics files.  Any manipulation 
C         to the data to produce "interpolated" values at impact must be
C         done by the modules (ie. G4); it is NOT performed here.
C         
C
C--File Usage------------------------------------------------------------
C
C  Unit         Logical/file Name  Notes
C
C   ID_HEAD     HEAD               (I)   Parameter Definition
C   ID_CADIN    CADIN              (I)   Input records (lead cards)
C   ID_IMPACT7  IMPACT7.ASC        (I/O) Scratch. 
C   ID_IMPACT10 IMPACT10.ASC       (I/O) Scratch. 
C   ID_IMPACT   IMPACT.ASC         (O)   Sweep end results.
C   ID_TRAJBIN  TRAJBIN            (O)   binary trajectory data
C   ID_TRAJASC  TRAJASC            (O)   ascii trajectory data
C  
C   ID_TABOUT   TABOUT             (O)   Output records / scroll to screen
C                                        This was the original VAX version; 
C                                        unit 36 was opened with a file named
C                                        "sys$output" when screen display was
C                                        desired.  As this could not be 
C                                        duplicated on the PC, the unit 
C                                        was changed to *, standard output,  
C                                        and the file direction set by the 
C                                        command/batch file executing CADAC.
C  ID_STATBIN   STATBIN            (O)  binary tatistical data
C  ID_STATASC   STATASC            (O)  binary tatistical data
C  ID_CSAVE     CSAVE.ASC          (O) Saved state file (optional)
C
C--Program Format Notes-------------------------------------------------
C
C  *  WRITE Statements containing the string "%%%" were used for debug 
C     purposes only.  These statements are commented out for final releases 
C     but were left in.  The information may be useful in later analysis.
C
C
C  For compatibility with the utility programs in the CADAC series, the 
C  following program format rules must be followed:  
C
C  * Full comment lines must use the C in column 1, NOT the !.  Inline 
C    comments are permitted, but NOT on Equivalence or Dimension 
C    statements.
C
C  * Equivalence statements must be consecutive in blocks; NO COMMENT 
C    Lines (even blank comment lines) or other statements may be included 
C    within the blocks.  The blocks may be divided into the following 
C    predefined catagories:  
C      INPUT FROM OTHER MODULES
C      INPUT DATA
C      OUTPUT
C      DIAGNOSTICS
C    Blank comment lines are used to indicate the start/end of a block 
C    of equivalence statements.
C
C
C  This is the main "subroutine" for program cadac.
C
C--------------------------------------------------------------------
C
      CALL EXEC
C
C
      STOP
      END
      BLOCK DATA AAINIT
C
C-------------------------------------------------------------------------
C
C  This subroutine performs common initialization prior to execution of 
C  CADAC
C
C-------------------------------------------------------------------------
C
      COMMON /CCOM/    ICF(25), ICC(25), ICL(25), CA(25), 
     1                 CL(25), CT0(25), NC, ICL2(25)
C
      COMMON /COLLER/  HOL(5)
      CHARACTER        HOL*80
C
      COMMON /FLAG1/   INITGAUSS
      LOGICAL          INITGAUSS
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /FIRSTI/ FINIT
      LOGICAL FINIT
C
      COMMON /HCOM/    TITLE
      CHARACTER*100    TITLE       
C
      COMMON /IPSAV/   NCARDS, NHOL, JTYPES(500), LOCS(500), 
     1                 MODS(500), VA1S(500), VA2S(500), MOD2(500)
C
      COMMON /IPSAVC/  ALS(3,500), HOLS(5)
      CHARACTER        ALS*6, HOLS*80
C
      COMMON /IPSVSC/  MCRIS(20,2,4), VALS(20,2)
C
      COMMON /IPSVST/  JTSTS(20,60), LOCSTS(20,60), MODSTS(20,60), 
     1                 VA1STS(20,60), VA2STS(20,60), MOD2ST(20,60),
     2                 NCD(20)
C
      COMMON /IPSVSTC/ ALSTS(20,3,60)
      CHARACTER        ALSTS*6
C
      COMMON /IPSVSCC/ MCRISC(20,2,2)
      CHARACTER        MCRISC*6
C
      COMMON /IPSVWD/  NWD, WXS(6,50) 
C
      COMMON /KRUN/    JRUN, MULRUN, IGROUP
C
      COMMON /NAD/     IBEEN, IBEGIN, ICARD, ISAVE
C
      COMMON /OINDAT/  J16, ICD, I16
C
      COMMON /OPINIT/  IPLINIT(70), INTPINIT(70), NINITVAR
      LOGICAL          INTPINIT
C
      COMMON /OPINITC/ INITLAB
      CHARACTER        INITLAB(70)*8
C
      COMMON /OPFLAG/ INTMSG, STGMSGOUT, INECHO, XSWEEP
      LOGICAL         INTMSG, STGMSGOUT, INECHO, XSWEEP
C
      COMMON /OPFLGC/  FMTSTRING, TRACE
      CHARACTER        FMTSTRING*85, TRACE(16)*8
C
      COMMON /OPPLOT/  IPLADD(70), INTPLOT(70)
      LOGICAL          INTPLOT
C
      COMMON /OPPLTC/  ALABLE
      CHARACTER        ALABLE(70)*8
C
      COMMON /OPSVAR/  ISCROL, KLOC(16), LPRT, IHEADP, INTS(16)
      LOGICAL          INTS
C
      COMMON /OPTRACK/  IPLTRACK(70), INTPTRACK(70), NTRACKVAR
      LOGICAL           INTPTRACK
C
      COMMON /OPTRACKC/ TRACKLAB
      CHARACTER         TRACKLAB(70)*8
C
      COMMON /PREV/    TPREV, CPPREV, PPPREV
C
      COMMON /RUNDAT/  IRUN   
C
      COMMON /STAGE/   LOC(2), INCRS(2), VAL(2), UNITS(2), KODE(2), 
     1                 TEST(2), LOCT(2), NTEST
C
      COMMON /STAGE1/  ISTAGE, NUMSTAGE
C
      COMMON /STAGEC/  NAME1(2), NAME2(2)
      CHARACTER        NAME1*6, NAME2*6
C
      COMMON /WINDS/   WALT(50), WDIR(50), WVEL(50), RHX(50),
     1                 CTMP(50), WPRES(50), NWINDR, RHW
C
      COMMON /WSET/    NCARD, JTYPE(500), LOCA(500), MOE(500), 
     1                 VA1(500), VA2(500), M2(500)
C
      COMMON /WSETC/   AL(3,500), HOLL(5)
      CHARACTER        AL*6, HOLL*80
C
      COMMON /WSETSC/  MCRI(20,2,4), WVAL(20,2)
C
      COMMON /WSETSCC/ MCRIC(20,2,2)
      CHARACTER        MCRIC*6
C
      COMMON /WSETST/  NCDW(20), JTST(20,60), LOCST(20,60),
     1                 MODST(20,60), VA1ST(20,60), VA2ST(20,60), 
     2                 M2ST(20,60)
C
      COMMON /WSETSTC/ ALST(20,3,60)
      CHARACTER        ALST*6
C
      COMMON /WSETWT/  WX(6,50) 
C
C
C-----------------------------
C
C     The blank common : C(3510)
C     The C variables defined here are those used by the executive 
C     routine;  those c variables assigned to the modules are not
C     defined here as the definition varies depending on the modules
C     used (and written by the user).
C      
C      C(0001) = ERRVAL (Amrk) The maximum integration step error value 
C      C(0002) = ERRN   (Amrk) IPL element number of var causing ERRVAL
C      C(0003) = AERR  (Amrk) C element number of var causing ERRVAL
C      C(0004) = PRELOC (Amrk) Previous C element number causing ERRVAL
C
C      C(0051) = REARTH (Exec) Radius of the Earth in user-sel units
C      C(0052) = CRAD (Exec) Conversion factor. (Degrees / Radians)
C      C(0053) = OPTMET (EXEC) Units of measure 1 = metric; 0 = English
C      C(0054) = AGRAV (Exec) Acceleration due to gravity @ sea level
C      C(0055) = CFTM (Exec) Conversion factor. (Meters / Feet)
C      C(0056) = CKFPS (Exec) Conversion factor. (Knots / ( ft/sec.) )
C      C(0057) = AMU (Exec) Gravitational parameter mu for the Earth (ft^3/sec^2)
C      C(0058) = WEII3 = omega = angular rotation of the earth (rad/sec)
C      C(0059) = OPNORO - Option flag:  0 = rotating earth model 
C                WEII3 = 7.2921154E-05;   1 = Non-rotating earth model 
C                WEII3 = 0.0
C
C      C(0090) = RANSEED (Exec) Random function generator initialization.
C                Added under SEU 91-02, this value is used to initialize 
C                the system's random number generator.
C
C      C(1772) = TRCOND (G4) Termin. Condit Codes from right to left.
C
C      C(1800) = ISWEEP - (Swp) Sweep option flag (0 through 5)
C      C(1801) = CRITNO - (Swp) Critical variable C location
C      C(1802) = CRITVAL - (Swp) Minimum test for critical variable
C      C(1803) = SEARNO - (Swp) Number of binary searche runs (opt 4 and 5)
C      C(1804) = NUMR - (Swp) The number of trajectory runs
C      C(1805) = CRITMAX - (Swp) The maximum test for critical variable
C      C(1811) = ANGLNO - (swp) The C location of the angluar variable
C      C(1812) = ANGMIN - (Swp) The minimum angle value
C      C(1813) = ANGMAX - (Swp) The maximum angle value
C      C(1814) = ANGDEL - (Swp) The Delta angle
C      C(1815) = ANGUNT - (Swp) The units of the input data: rad or deg
C      C(1821) = RANGNO - (Swp) The C location of the range variable
C      C(1822) = RANMIN - (Swp) The minimum range value
C      C(1823) = RANMAX - (Swp) The maximum range value
C      C(1824) = RANDEL - (Swp) The delta range value
C
C      C(2000) = TIME = Current integration Time in the trajectory.
C      C(2001) = TSTAGE = ? Time when the last stage occurred.
C      C(2003) = PCNT = Time of the next print to TABOUT
C      C(2004) = PPNT = Time of next print to the plot files. 
C                (traj.* and stat.*)
C      C(2005) = PPP (Exec) Frequency (time) of writing the plot data.
C      C(2006) = ITAP90 (Exec) A Flag: 0 = No CSAVE.ASC; 1 = trajectory 
C                started from data saved to CSAVE.ASC. (Used by D3I)
C      C(2011) = KSTEP (EXEC) Controls flow after an integration step.
C      C(2014) = ITCNT (Exec) Print flag counter
C      C(2015) = CPP (Exec) Frequency (time) of writing TABOUT data
C      C(2016) = PGCNT (Exec) Page counter flag
C      C(2020) = LCONV (Exec) Flag: 0 = start of traj; 2 = Stop calculations 
C      C(2127 - 2196) = PMIN(1 - 70)
C      C(2280) = NV = The number of variables in the plot list.
C      C(2285) = NJ   Number of state variables to be integrated 
C      C(2361) = NOMOD Number of modules to be called
C      C(2362 - 2460) = XMODNO(1 - 99) Array containing modules numbers to be called
C      C(2461) = NOSUB  Module number to be called
C      C(2462 - 2560) = SUBNO(1 - 99)  Array of module numbers
C      C(2561) = NIP - The number of variables being integrated
C      C(2562 - 2661) = IPL(1 - 100) The locations of the derivative of 
C                       the state variable. 
C      C(2662) = HMIN  Minimum integration value ?
C      C(2663) = HMAX  Maximum integration value ?
C      C(2664 - 2764) = DER(1 - 101) (Exec) Frequency of integration ?f
C      C(2765 - 2865) = V(1 - 101) 
C      C(2866) = ICOOR
C      C(2867-2967) = IPLV(1-100) The location of the state variable; 
C                     corresponding to the derivative in the IPL array.
C
C
C      DATA C/ 3510 * 0.0 /
C
C-----------------------------
C
C      /CCOM/ :
C       ICF(25) - (I) The function type for each defined functions
C       ICC(25) - (I) The combination code for each defined functions
C       ICL(25) - (I) The controlled variable for each defined function
C       CA(25)  - (R) The 1st parameter for each defined function
C       CL(25)  - (R) The 2nd parameter for each defined function
C                 (Modified by C11_process for the GAUSS function)
C       CT0(25) - (R) The time the function is defined. (Set to 0.0
C                 for the GAUSS function)
C          The above array index is from 1 to NC where:
C       NC - (I) Number of forcing functions that have been defined by 
C            type 11 input cards.
C       ICL2(I) - (I) The second integer from the input stream = 
C                 activated under task SEU 91-02.  May have different 
C                 uses depending on the function's definition.
C
      DATA ICF/ 25 * 0 /, ICC/ 25 * 0 /, ICL/ 25 * 0 /, CA/ 25 * 0.0/, 
     1     CL/ 25 * 0.0 /, CT0/ 25 * 0.0 /, NC / 0 /, ICL2/ 25 * 0 /
C                       
C-----------------------------
C
C     /FLAG1/ :
C        INITGAUSS - (L) Flag for forcing the calculation of random 
C                    deviates in the GAUSS module.  .T. = An unused 
C                    random deviate is ready for use;  .F. = Need to
C                    calculate another pair.
C
      DATA  INITGAUSS/ .FALSE. /
C
C-----------------------------
C
C     /HCOM/ :
C     TITLE = (C100) The input data title written to the TRAJ.* and 
C             STAT.* files.
C
      DATA TITLE/ ' '  / 
C                          
C-----------------------------
C
C     /IPSAV/ :
C     NCARDS = (I) The number of cards in the stage deck that form the 
C              trajectory initialization (ie all cards prior to the 
C              first card type 6 or 12).  These cards are saved in 
C              special save arrays and reused at the start of each 
C              trajectory rerun.
C     NHOL   = (I) Number of header cards entered in the input card deck.
C              (during the trajectory initialization)
C     These arrays are storage arrays that contain the data from the 
C     input initialization cards.  The initialization cards are the input 
C     cards until the first card type 6 or 12 is reached.  The main card 
C     data is stored in these arrays and reloaded at the beginning of 
C     each trajectory in multi trajectory run cases.  
C     JTYPES(500) - (I) Contains the first integer (card types) from 
C                   the input cards.
C     LOCS(500)   - (I) Contains the second integer from the input card.
C     MODS(500)   - (I) Contains the third integer from the input card.
C     VA1S(500)   - (R) Contains the first real from the input card.
C     VA2S(500)   - (R) Contains the second real from the input card.
C     MOD2(500)   - (I) Contains a fourth integer from the input card.
C     For the above arrays, the index is the card number from 1 to 
C     NCARDS.
C
      DATA NCARDS/ 0 /, NHOL/ 0 /, JTYPES/ 500 * 0 /, LOCS/ 500 * 0 /, 
     1     MODS/ 500 * 0 /,  VA1S/ 500 * 0.0 /, VA2S/ 500 * 0.0 /,
     2     MOD2/ 500 * 0 /

C
C-----------------------------
C
C     /IPSAVC/ 
C     These arrays are storage arrays that contain the CHARACTER data from 
C     the initialization cards.  The initialization cards are the input 
C     cards until the first card type 6 or 12 is reached.  The main card 
C     data is stored in these arrays and reloaded at the beginning of 
C     each trajectory in multi trajectory run cases.  
C     ALS(3,500) - (C6) Storage array containing the 3 sets of 
C                  character data entered with the input initialization 
C                  cards.  Index = 1, NCARDS
C     HOLS(5)    - (C80) Storage array containing the character data 
C                  entered with a type 9 card with the initialization 
C                  cards. (Index = 1, NHOLS )
C
      DATA ALS/ 1500 * '      ' /, ( HOLS(J), J=1,5)/ 5 * ' '  / 
C      
C-----------------------------
C
C     /IPSVSC/ : 
C     These arrays are storage arrays that contain the data from 
C     the type 10 (Stage Criteria) cards within the initialization 
C     card set. The initialization cards are the input cards until the 
C     first card type 6 or 12 is reached.  The card data is stored in 
C     these arrays and reloaded at the beginning of each trajectory in 
C     multi trajectory run cases.   MAXIMUM NUMBER OF STAGES = 20
C     MCRIS(20,2,4) - (I) Contains integer data from the type 10 cards.
C     VALS(20,2)    - (R) Contains real data from the type 10 cards.
C
      DATA MCRIS/ 160 * 0 /, VALS/ 40 * 0.0 /
C      
C-----------------------------
C
C     /IPSVSCC/ : 
C     This arrays is a storage array that contains the CHARACTER data 
C     from the type 10 (Stage Criteria) cards within the initialization 
C     card set. The initialization cards are the input cards until the 
C     first card type 6 or 12 is reached.  The card data is stored in 
C     these array and reloaded at the beginning of each trajectory in 
C     multi trajectory run cases.  MAXIMUM NUMBER OF STAGES = 20
C     MCRISC(20,2,2) - (C6) Storage array containing the 2 sets of 
C                      character data for the type 10 cards from the 
C                      initialization deck.  
      DATA MCRISC/ 80 * '      ' /
C
C-----------------------------
C
C     /IPSVST/ :
C     These arrays are storage arrays that contain the data from 
C     the STage cards within the initialization card set. The 
C     initialization cards are the input cards until the first card 
C     type 6 or 12 is reached.  These cards are executed at the beginning 
C     of a trajectory for each multirun/montecarlo run. The data is 
C     transferred from these arrays to the working set of arrays at the 
C     begining of each run.  Any data entered by a type 12 card is then 
C     applied to the cards.  N = 1-20 = stage number; NN = 1-60 = card
C     number for the set of cards in stage N = 1 to NCD( N )
C     JTSTS(20,60)  - (I) First integer from card data = cardtype.
C     LOCSTS(20,60) - (I) Second integer from the card data.
C     MODSTS(20,60) - (I) Third integer from the card data.
C     VA1STS(20,60) - (R) First real value from the card input data.
C     VA2STS(20,60) - (R) Second real value from the card input data.
C     MOD2ST(20,60) - (I) Fourth integer from the card data.
C     NCD(20)       - (I) Number of cards for stage N following the type 
C                      16 card until a type 6, 10 or 12 card occurrs.  
C                      This is the max NN values for the above storage 
C                      arrays.
C
      DATA JTSTS/ 1200 * 0 /, LOCSTS/ 1200* 0 /, MODSTS/ 1200* 0 /, 
     1     VA1STS/ 1200* 0.0 /, VA2STS/ 1200 * 0.0/, 
     2     MOD2ST/ 1200 * 0 /, NCD/ 20 * 0 /
C
C-----------------------------
C
C     /IPSVSTC/ : 
C     These arrays are storage arrays that contain the CHARACTER data 
C     from the STage cards within the initialization card set. The 
C     initialization cards are the input cards until the first card 
C     type 6 or 12 is reached.  These cards are executed at the beginning 
C     of a trajectory for each multirun/montecarlo run. The data is 
C     transferred from these arrays to the working set of arrays at the 
C     begining of each run.  Any data entered by a type 12 card is then 
C     applied to the cards.  N = 1-20 = stage number; NN = 1-60 = card
C     number for the set of cards in stage N = 1 to NCD( N )
C     ALSTS(20,3,60) - (C6) A storage array containing the character 
C              data from the input cards.  This arrays belongs with the 
C              storage set of arrays : JTSTS, LOCSTS, MODSTS, etc, found in 
C              common /IPSVST/. See these variable definitions for more 
C              information.
C
      DATA ALSTS/ 3600 * ' ' /
C      
C-----------------------------
C
C     /IPSVWD/ :
C     This array is a storage array that contains the WEATHER data 
C     within the initialization card set. The initialization cards are 
C     the input cards until the first card type 6 or 12 is reached.  
C     These cards are executed at the beginning of a trajectory for 
C     each multirun/montecarlo run. The data is transferred from these 
C     arrays to the working set of arrays at the begining of each run.  
C     NWD - (I) The number of atmospheric data sets read into the 
C                 WXS array.  
C     WXS(6,50) - (R) Contains the atmospheric data as read from the 
C                input cards.  WXS(I,J) : I => 1 = Altitude, 2 = 
C                Wind Direction, 3 = Wind Velocity, 4 = Density, 
C                5 = Temperature, 6 = Pressure
C                Up to J=50 sets of atmospheric data may be entered.
C
      DATA NWD/ 0 /, WXS/ 300 * 0.0 /
C      
C      
C-----------------------------
C      
C     /KRUN/ :
C     JRUN   - (I) Run number/counter for the multi-run cases.
C     MULRUN - (I) Flag that indicates if case is a multi-run case or 
C              not:  0 = NOT multi-run case;  N = Number of runs in 
C              the Multi-run case. 
C     IGROUP - (I) The group number/counter
C
      DATA JRUN/ 1 /, MULRUN/ 0 /, IGROUP/ 1 /
C
C-----------------------------
C
C      /NAD/   :
C      IBEEN, 
C      IBEGIN - (I) The Stage number where a save of C to tape 90 
C               occurred.
C      ICARD  - (I) The card number where a save of C to tape 90 
C               occurred.
C      ISAVE  - (I) Flag: indicates that the C array has been saved to tape 
C               90
C
      DATA IBEEN/ 0 /, IBEGIN/ 0 /, ICARD/ 0 /, ISAVE/ 0 /
C
C-----------------------------
C
C     /OINDAT/  :
C      J16  - (I) FLAG: 0 = Pull card data from the main trajectory 
C             arrays;  1 = Pull card data from the stage data arrays.
C      ICD  - (I) Counter.  The card number for the main trajectory 
C             arrays, of the card currently being processed by OINPT1 
C      I16  - (I) Counter.  The card number for the stage arrays, of the
C             card currently being processed by OINPT1.
C
      DATA J16/ 0 /, ICD/ 0 /, I16/ 0 /
C
C-----------------------------
C
C     /OPFLAG/ :
C     INTMSG    = (L) T= Print integration error messages to both 
C                        sys$output and tabular output (?).  F= supress
C                        integration error message displays.
C     STGMSGOUT = (L) T= Print stage messages to Tabout file; 
C                     F= supress staging messages.
C     INECHO    = (L) T= Echo the input to the output file;  
C                     F= supress the echo of the input deck.
C     XSWEEP    = (L) T= Execution is a SWEEP run
C                     F= Execution is not a SWEEP run
C
      DATA INTMSG/ .FALSE. /, STGMSGOUT/ .FALSE. /, INECHO/ .TRUE. / 
     1     XSWEEP/ .FALSE. /
C
C-----------------------------
C     /FILEFLG/  
C
C     TRAJBIN   = (L) T= create binary trajectory file 
C                     F= don't create binary trajectory file
C     TRAJASC   = (L) T= create ascii trajectory file
C                     F= don't create ascii trajectory file
C     STATBIN   = (L) T= create binary statistics file
C                     F= don't create binary statistics file
C     STATASC   = (L) T= create ascii statistics file 
C                     F= don't create ascii statistics file
C     TABOUT    = (L) T= create output to TABOUT.ASC
C                     F= write output to screen
C     RANVAR    = (L) T= Print type 3 and type 11 random value 
C                        assignments of variables to unit 37 = RANVAR.ASC
C     INITASC   = (L) T= create ascii RT initializtion file
C                     F= don't create ascii RT initializtion file
C     INITBIN   = (L) T= create binary RT initializtion file
C                     F= don't create binary RT initializtion file
C     TRACKASC  = (L) T= create ascii RT track data file
C                     F= don't create ascii RT track data file
C     TRACKBIN  = (L) T= create binary RT track data file
C                     F= don't create binary RT track data file
      DATA TRAJBIN/.FALSE./, TRAJASC/.FALSE./, STATBIN/.FALSE./, 
     1     STATASC/.FALSE./, TABOUT/.FALSE./,  RANVAR/ .FALSE. /,
     2     INITASC/.FALSE./, INITBIN/.FALSE./,
     3     TRACKASC/.FALSE./, TRACKBIN/.FALSE./
C
C-----------------------------
C      /FILEIDS/
C      ID_CADIN    (I) - file id for input file CADIN.ASC 
C      ID_HEAD     (I) - file id for input head.asc
C      ID_CSAVE    (I) - file id for saved states file 
C      ID_TRAJBIN  (I) - file id for binary trajectory file
C      ID_TRAJASC  (I) - file id for ascii trajectory file
C      ID_STATBIN  (I) - file id for binary statistics file
C      ID_STATASC  (I) - file id for ascii statistics file
C      ID_TABOUT   (I) - file id for tabular output file
C      ID_RANVAR   (I) - file id for random variable file
C      ID_INITASC  (I) - file id for ascii RT CADAC initialization file
C      ID_INITBIN  (I) - file id for binary RT CADAC initialization file
C      ID_TRACKASC (I) - file id for ascii RT CADAC track data file
C      ID_TRACKBIN (I) - file id for binary RT CADAC track data file
C
C
      DATA ID_CADIN/35/,   ID_HEAD/ 3/ ,   ID_CSAVE/90/, ID_TABOUT/6/ 
      DATA ID_TRAJBIN/11/, ID_TRAJASC/12/
      DATA ID_STATBIN/44/, ID_STATASC/45/   
      DATA ID_RANVAR/37/
      DATA ID_IMPACT/22/,   ID_IMPACT7/ 7/,  ID_IMPACT10/10/
      DATA ID_INITASC/50/, ID_INITBIN/51/
      DATA ID_TRACKASC/60/, ID_TRACKBIN/61/
C
C-----------------------------
C
C     /OPFLGC/ :
C     FMTSTRING  = (C) Contains the format to use when printing the 
C                  scroll variables.
C     TRACE(16)  = (C8) Scroll variable parameter name (acronym).
C
      DATA FMTSTRING/ ' ' /,  TRACE/ 16 * ' ' /
C
C-----------------------------
C
C     /OPPLOT/: 
C     IPLADD(70) = (I) Contains the list of C common locations to be 
C                  printed to the plot data file. (TRAJ.*/STAT.*)
C     INTPLOT(70) = (L) Flag indicating if the plot variable is a real 
C                  variable (.false.) or an integer variable (.true.)
C
      DATA IPLADD/ 70 * 0 /, INTPLOT/ 70 * .FALSE. /
C
C
C-----------------------------
C
C     /OPPLTC/: 
C     ALABLE(70) = (C8) Contains the aronyms of the C common locations 
C                  that are to be printed to the plot data file.
C                  (TRAJ.*/STAT.*)
C
      DATA  ALABLE/ 70 * '        ' /
C
C-----------------------------
C
C     /OPINIT/: 
C     IPLINIT(70)  = (I) Contains the list of C common locations to be 
C                    printed to the RT initialization file. (INIT.ASC/BIN)
C     INTPINIT(70) = (L) Flag indicating if the plot variable is a real 
C                    variable (.false.) or an integer variable (.true.)
C     NINITVAR     = (I) The number of variables to be plotted on the
C                    RT initialization data file
C
      DATA IPLINIT/ 70 * 0 /, INTPINIT/ 70 * .FALSE. /
C
C
C-----------------------------
C
C     /OPINITC/: 
C     INITLAB(70) = (C8) Contains the aronyms of the C common locations 
C                   that are to be printed to the RT initialization file.
C                   (INIT.ASC/BIN)
C
      DATA  INITLAB/ 70 * '        ' /
C
C
C-----------------------------
C
C     /FIRSTI/: 
C     FINIT = (L) Flag inidicating to write to INIT.ASC file the first time
C                 the C array is loaded with the intialization data
C
      DATA FINIT/.TRUE./
C
C
C-----------------------------
C
C     /OPSVAR/ :
C     ISCROL   = (I) Flag: 0 = NO scroll variables; 1 = Scroll 
C                variables defined, display them on the screen/output.
C     KLOC(16) = (I) C element location of the scroll variables.
C     LPRT     = (I) Number of scroll variables.
C     IHEADP   = (I) Counts the number of lines printed to output 
C                under the SCROLL option.  The counter used for 
C                displaying the header information every 10 data 
C                lines.
C     INTS(16) = (L) Integer flag indicating whether the scroll variable 
C                is a real number (= 0 ) or an integer number ( = 1)
C
      DATA ISCROL/ 0 /, KLOC/ 16 * 0 /, LPRT/ 0 /, IHEADP/ 0 /, 
     1     INTS/ 16 * .FALSE. /
C
C-----------------------------
C
C     /OPTRACK/: 
C     IPLTRACK(70)  = (I) Contains the list of C common locations to be 
C                     printed to the RT track data file. (TRACK.ASC/BIN)
C     INTPTRACK(70) = (L) Flag indicating if the plot variable is a real 
C                     variable (.false.) or an integer variable (.true.)
C     NTRACKVAR     = (I) The number of variables to be plotted on the
C                     RT track data file 
C
      DATA IPLTRACK/ 70 * 0 /, INTPTRACK/ 70 * .FALSE. /
C
C
C-----------------------------
C
C     /OPTRACKC/: 
C     TRACKLAB(70) = (C8) Contains the aronyms of the C common locations 
C                    that are to be printed to the RT track data file.
C                    (TRACK.ASC/BIN)
C
      DATA  TRACKLAB/ 70 * '        ' /
C
C-----------------------------
C
C
C      /PREV/ :
C      TPREV  - (R) The time the previous stage occurred.
C      CPPREV - (R) The saved tabular print interval.  Used to detect 
C               whether the CPP value has been modified or not.
C      PPPREV - (R) The saved plot print interval.  Used to detect
C               whether the PPP value has been modified or not.
C
       DATA TPREV/ 0.0 /, CPPREV/ 0.0 /, PPPREV/ 0.0 /
C
C-----------------------------
C
C      /RUNDAT/  :
C      IRUN  - (I) Counter for the runs executed in the sweep methodology.
C
       DATA IRUN/ 0 /
C
C
C-----------------------------
C
C      /STAGE/  :
C      LOC(2)   - (I) C element location of the staging variable
C      INCRS(2) - (I) Flag to determine relationship of staging variable 
C                 value to staging criteria.  0 : <=  ;  1 : >=
C      VAL(2)   - (R) The (KODE=0) the staging criteria; (KODE>0) the C 
C                 element containing the staging criteria; (KODE<0) an 
C                 amount added to the original value of the LOC variable
C                 (prior to the stage) giving the staging criteria.
C      UNITS(2) - (R) Unused at this point ?
C      KODE(2)  - (I) Flag to determine how the VAL data is to be used
C      TEST(2)  - (R) (KODE<=0) The staging test criteria
C      LOCT(2)  - (I) (Kode>0) The C element containing the staging test 
C                 criteria
C         For the above arrays, the index = 1, NTEST, the number of 
C         staging tests.
C      NTEST    - (I) The number of staging tests (Max=2)
C
C      DATA LOC(2), INCRS(2), VAL(2), UNITS(2), KODE(2), 
C     1                TEST(2), LOCT(2), NTEST
C
C-----------------------------
C
C      /STAGE1/ : 
C      ISTAGE   - (I) Flag: 0 = Start of the trajectory;  16 = Execute 
C                 until the stage criteria is met;  6 = Execute until end 
C                 of trajectory.
C      NUMSTAGE - (I) The number of the stage currently being processed.
C
      DATA ISTAGE/ 0 /, NUMSTAGE/ 0 /
C
C-----------------------------
C
C      /STAGEC/ : 
C      NAME1(2) - (C6) The input variable name of the staging variable
C      NAME2(2) - (C6) (Kode>0) The input variable name of the variable 
C                 whose value is to be used as the staging criteria.
C
C      DATA NAME1(2), NAME2(2)
C
C-----------------------------
C
C     /WINDS/ 
C     WALT(50)
C     WDIR(50)
C     WVEL(50)
C     RHX(50)
C     CTMP(50)
C     WPRES(50) - 
C     NWINDR -    (I) Dummy variable to keep alignment with this common 
C                 block in the modules.
C     RHW
C
C
C-----------------------------
C
C     /WSET/ : 
C      These arrays contain the working set of the lead trajectory 
C      cards.  They are initialized by being set to the saved 
C      initialization arrays (contain the original initialization cards 
C      read from input), then the cards for the current trajectory group 
C      are added or modify this set accordingly.
C     NCARD - (I) The number of cards in the working set.  Initialized 
C              to the number of cards in the saved set (ncards), then 
C              incremented for each card pertaining to the current 
C              trajectory.
C     JTYPE(J) - (I) 
C     LOCA(J)  - (I)   -- See the IPSAV common variables for definitions
C     MOE(J)   - (I) 
C     VA1(J)   - (R) 
C     VA2(J)   - (R) 
C     M2(J)    - (I) 
C      For the above variables, J = 1, NCARD with a maximum of 500.
C
      DATA NCARD/ 0 /, JTYPE/ 500 * 0 /, LOCA/ 500 * 0 /, 
     1     MOE/ 500 * 0 /, VA1/ 500 * 0.0 /, VA2/ 500 * 0.0 /,
     2     M2/ 500 * 0 /
C
C-----------------------------
C
C     /WSETC/ :
C      These arrays contain the working set CHARACTER data for the 
C      lead trajectory cards.  They are initialized by being set to 
C      the saved initialization arrays (contain the original 
C      initialization cards read from input), then the cards for the 
C      current trajectory group are added or modify this set accordingly.
C      See common /IPSAVC/ for definitions.
C      AL(3,500)     - (C6)    
C      HOLL(5)       - (C80)
C
      DATA AL/ 1500 * ' ' /, HOLL/ 5 * ' ' / 
C
C-----------------------------
C
C     /WSETSC/  :
C     These arrays contain the working set trajectory data from 
C     the type 10 (Stage Criteria) cards. 
C     MCRI(20,2,4) - (I) Contains integer data from the type 10 cards.
C     WVALS(20,2)    - (R) Contains real data from the type 10 cards.
C
      DATA MCRI/ 160 * 0 /, WVAL/ 40 * 0.0 /
C
C-----------------------------
C
C     /WSETSCC/ :
C      MCRIC(20,2,2) - (C) This array contains the working set 
C                      trajectory CHARACTER data from the type 10 
C
       DATA MCRIC/ 80 * ' ' /
C
C-----------------------------
C
C      /WSETST/ : 
C     These arrays are the working arrays that contain the data from 
C     the STage cards.  See common /IPSVST/ for definitions.
C     NCDW(20) - (I) 
C     JTST(20,60)  - (I) 
C     LOCST(20,60) - (I) 
C     MODST(20,60) - (I) 
C     VA1ST(20,60) - (R) 
C     VA2ST(20,60) - (R) 
C     M2ST(20,60)  - (I)
C
      DATA JTST/ 1200 * 0 /, LOCST/ 1200 * 0 /, MODST/ 1200 * 0 /, 
     1     VA1ST/ 1200 * 0.0 /, VA2ST/ 1200 * 0.0/, NCDW/ 20 * 0 /,
     2     M2ST/ 1200 * 0.0 /
C
C-----------------------------
C
C     /WSETSTC/ : 
C     This array is the working set array containing the CHARACTER data 
C     from the STage cards.  N = 1-20 = stage number; NN = 1-60 = card
C     number for the set of cards in stage N = 1 to NCD( N )
C     ALST(20,3,60) - (C6) A storage array containing the character 
C              data from the input cards.  This arrays belongs with the 
C              storage set of arrays : JTST, LOCST, MODST, etc, found in 
C              common /WSETST/ See these variable definitions for more 
C              information.
C
      DATA ALST/ 3600 * ' ' /
C      
C-----------------------------
C
C     /WSETWT/  : WX(6,50) 
C     This array is a working array that contains the WEATHER data. 
C     WX(6,50) - (R) Contains the atmospheric data as read from the 
C                input cards.  WX(I,J) : I => 1 = Altitude, 2 = 
C                Wind Direction, 3 = Wind Velocity, 4 = Density, 
C                5 = Temperature, 6 = Pressure
C                Up to J=50 sets of atmospheric data may be entered.
C
      DATA WX/ 300 * 0.0 /
C
C-----------------------------
C
      END
C      INTEGER*4 FUNCTION HANDL( SIGARGS, MECHARGS )
C
C-------------------------------------------------------------------------
C
C  The "subroutine" handl generates the Dump.dat file when an error
C  (math, overflow, etc) is caused by the program/module.
C
C--Argument Definitions-------------------------------------------------
C
C  SIGARGS(2)  - (I) Input.
C  MECHARGS(5) - (I) Input.
C
C-------------------------------------------------------------------------
C
C      COMMON C(3510)
C
C      DIMENSION   IC(3510)
C      EQUIVALENCE (C(0001), IC(0001) )
C
C      INTEGER*4 SIGARGS(2), MECHARGS(5)
C
C      INCLUDE '($SSDEF)'
C
C
C      OPEN( 89, FILE='DUMP.BIN', STATUS='NEW', FORM='BINARY',
C     1           RECORDTYPE='SEGMENTED', ACCESS='SEQUENTIAL',
C     2           ORGANIZATION='SEQUENTIAL' )
C
C      WRITE(89) C, IC
C      CLOSE (89)
C
C      WRITE(ID_TABOUT,*) 
C      WRITE(ID_TABOUT,*) ' **** WRITE ALL C-LOCATIONS  ON DUMP.DAT ****'
C      WRITE(ID_TABOUT,*) '  USE [ZIPFELP.CADAC]DUMP.EXE TO EXAMINE'
C      WRITE(ID_TABOUT,*) ' THEIR CONTENTS AT THE FATAL ERROR.'
C      WRITE(ID_TABOUT,*) 
C
C      RETURN
C      END
      SUBROUTINE AMRK
C
C-------------------------------------------------------------------------
C
C  Modified EULER numerical integration algorithm:
C   Given:  
C           Y' = F( t, y )
C   Estimate Y = F( t, y ) by:
C           w(i+1) =  w(i)  +  h/2(  f[ t(i), w(i) ] 
C                              +  f[ t(i+1), w(i) + h f[ t(i), w(i) ] ] )
C   given w(o) = initial value of y.
C   
C
C-------------------------------------------------------------------------
C
C
      COMMON  C(3510)
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /OPFLAG/ INTMSG, STGMSGOUT, INECHO, XSWEEP
      LOGICAL         INTMSG, STGMSGOUT, INECHO, XSWEEP
C
      DIMENSION  DER(101), IPL(100), V(101)
C
      EQUIVALENCE (C(0001), ERRVAL )
      EQUIVALENCE (C(0002), ERRN   )
      EQUIVALENCE (C(0003), AERR   )
      EQUIVALENCE (C(0004), PRELOC )
      EQUIVALENCE (C(2001), TSTAGE )
      EQUIVALENCE (C(2285), NJ     )
      EQUIVALENCE (C(2664), DER(1) )
      EQUIVALENCE (C(2562), IPL(1) )
      EQUIVALENCE (C(2765), V(1)   )
      EQUIVALENCE (C(2866), ICOOR )
C
      DIMENSION PRED(100), OLD(100)
      DATA      OLD/ 100 * 0.0 /
C
C
C---  Improved Euler method of numerical integration.
C
C---  Calculate the prediction value: 
C         f[  t(i+1),  w(i+1) + hf( t(i), w(i) )  ]
C
C     Set the flag to indicate that the predictor loop is being 
C     performed.
C
      ICOOR = 0
C
      DO I = 1, NJ 
C
C        Load the array with the initial values: f( t(i), w(i) )
C
         OLD(I)  = DER(I+1)
C
C        Calculate:  w(i+1) + h f( t(i), w(i) )
C
         V(I+1)  = V(I+1) + OLD(I) * DER(1)
C
C        Save these values:  PRED = w(i+1) + h f( t(i), w(i) )
C
         PRED(I) = V(I+1)
      ENDDO
C
C     Increment time to t(i+1):
C
      V(1) = V(1) + DER(1)
C
C     Calculate:  f[  t(i+1),  w(i+1) + hf( t(i), w(i) )  ]
C
      CALL AUXSUB
C
C     Note:  the AUXSUB loads the C array from the V data and 
C     reloads the DER array at the end of the module execution.
C     V NOW contains the value: w(i+1) + h f( t(i), w(i) ) after 
C            calculations of the function.
C     DER NOW contains the the value: 
C             f[  t(i+1),  w(i+1) + hf( t(i), w(i) )  ]
C
C
C---  Corrector loop.
C
C     Set the flag to indicate the correction loop is being performed.
C
      ICOOR = 1
C
C     Compute half the time step:
C
      HALFD = DER(1) / 2.0
C
C     Calculate the new value.  This APPEARS to have a sign error in the 
C     equation.  However this is just due to the definitions of the 
C     variables.  Remember - trying to calculate the following:
C           w(i+1) =  w(i)  +  h/2(  f[ t(1), w(i) ] 
C                              +  f[ t(i+1), w(i) + h f[ t(i), w(i) ] ] )
C     At this point in the calculations:
C        V(i)   = w(i+1) + h f( t(i), w(i) )
C        Der(i) = f[  t(i+1),  w(i+1) + hf( t(i), w(i) )  ]
C        Old(i) = f( t(i), w(i) )
C     Substituting in values:
C     V(i+1) = { w(i+1) + h f( t(i), w(i) ) } 
C              + h/2 {  f[ t(i+1), w(i+1) + hf( t(i), w(i) ) ]
C                       - f( t(i), w(i) ) }
C     Distribute h/2 and rearrange terms:
C     V(i+1) = w(i+1) + h f( t(i), w(i) ) - (h/2) f( t(i), w(i) ) 
C                    + (h/2) f[ t(i+1), w(i+1) + hf( t(i), w(i) ) ] 
C     Subtracting  f( t(i), w(i) ) terms:
C     V(i+1) = w(i+1) + (h/2) f( t(i), w(i) ) 
C                    + (h/2) f[ t(i+1), w(i+1) + hf( t(i), w(i) ) ] 
C     Factoring h/2 from both terms giving : 
C     V(i+1) = w(i+1) + (h/2) {  f( t(i), w(i) ) 
C                    + f[ t(i+1), w(i+1) + hf( t(i), w(i) ) ]  }
C
      DO I = 1, NJ 
         V(I+1) = V(I+1) + (DER(I+1) - OLD(I)) * HALFD
      END DO
C
C     
C---  Perform some integration error checking:
C
      IF( TSTAGE .GE. 0.1 ) THEN 
C
C         Find the integration variable that caused the greatest
C         error for THIS TIME STEP.
C
C         Initialize the error value.
C
          ERRVAL = 0
C
C
          DO I = 1, NJ 
C 
C            Skip the elements assigned to the C4 module.
C
             IF( .NOT. ( IPL(I) .GE. 1100 .AND.  IPL(I) .LT. 1200 ) ) 
     1       THEN 
C
C                Remember: 
C                    PRED = w(i+1) + h f( t(i), w(i) ) PRIOR to 
C                           calculating the derivative function value.
C                    V(i) = w(i+1) + h f( t(i), w(i) ) AFTER the 
C                           calculations of the derivative. 
C
                 DEN = AMAX1( ABS( V(I+1) + PRED(I) ), 2.0 )
                 ERR = ABS( 2.0 * ( V(I+1) - PRED(I) ) / DEN )
C
C
                 IF(  ERR  .GE. ERRVAL  ) THEN 
C
C                    The error value is bigger than the previous error
C                    Update the error parameters.
C
                     ERRN   = I         ! Integration element number
                     AERR   = IPL( I )  ! C element number
                     ERRVAL = ERR       ! error value
                 ENDIF
             ENDIF
C
          ENDDO
C
C
          IF( AERR .EQ. PRELOC ) THEN 
C
C             Previous variable producing the max error value.
C             Increment the error counter.
C
              IERRCOUNT = IERRCOUNT + 1
C
              IF( INTMSG  .AND.  IERRCOUNT .GT. 100  .AND.  
     1            PRELOC .NE. PREMESSAGE     ) THEN 
C
C                 The variable has been the maximum error for over 100 
C                 integration steps AND the message has not been 
C                 previously displayed for this variable AND the
C                 integration messages are to be displayed.
C
                  WRITE(ID_TABOUT,500) AERR, ERRVAL 
                  IF( TABOUT ) WRITE(6,500) AERR, ERRVAL
  500             FORMAT( 1X, '*** INTEGRATION WARNING ***' /, 
     1                    4X, 'C LOCATION: ', F7.0, ' generated an',
     2                        ' error of ', G15.6 )
C
                  IERRCOUNT = 1
C 
C                 Save the variable number the message was printed for.
C
                  PREMESSAGE = PRELOC
C
              ENDIF
C
          ELSE
C
C             New variable causing the max error.
C
              PRELOC = AERR
              IERRCOUNT = 1
C
          ENDIF
C
C
      ENDIF
C
C
C     Compute the function value:
C
      CALL AUXSUB
C
      RETURN
      END
      SUBROUTINE AUXI
C
C-------------------------------------------------------------------------
C
C     This module controls the execution of the initialization modules 
C     for the MODULES entered on the type 2 input cards.
C
C-------------------------------------------------------------------------
C
      LOGICAL STGEMET
C
      COMMON      C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      DIMENSION   XMODNO(99)
C
      EQUIVALENCE (C(2361), NOMOD )
      EQUIVALENCE (C(2362), XMODNO(1) )
      EQUIVALENCE (C(2561), NIP )
C
      NIP = 1
C
C---  Call SWEEP Methodologies
      CALL SWEEPI
C
C
      DO 1000 I = 1, NOMOD 

C
         L = XMODNO(I)
C
         GOTO ( 1000, 100, 110, 120, 130, 140, 150, 160, 
     1           170, 180, 190, 200, 200, 200, 200, 200,
     2           210, 220, 230, 240, 250, 260, 270, 280,
     3           290, 300, 310, 320, 330, 340, 350, 360 ), L
C
         WRITE(ID_TABOUT,*) '  GOTOER IN AUXI, L  = ',L
C
C
  100    CALL A1I
         GO TO 1000
C
  110    CALL A2I
         GOTO 1000
C
  120    CALL A3I
         GOTO 1000
C
  130    CALL A4I                            
         GOTO 1000
C
  140    CALL A5I
         GOTO 1000
C
  150    CALL C1I
         GOTO 1000
C
  160    CALL C2I
         GOTO 1000
C
  170    CALL C3I
         GOTO 1000
C
  180    CALL C4I
         GOTO 1000
C
  190    CALL C5I
         GOTO 1000
C
  200    CONTINUE
         GOTO 1000
C
  210    CALL D1I
         GOTO 1000
C
  220    CALL D2I
         GOTO 1000
C
  230    CALL D3I
         GOTO 1000
C
  240    CALL D4I
         GOTO 1000
C
  250    CALL D5I
         GOTO 1000
C
  260    CONTINUE
         CALL G1I
         GOTO 1000
C
  270    CALL G2I
         GOTO 1000
C
  280    CALL G3I
         GOTO 1000
C
  290    CALL G4I
         GOTO 1000
C
  300    CALL G5I
         GOTO 1000
C
  310    CONTINUE
         GOTO 1000
C
  320    CALL S1I
         GOTO 1000
C
  330    CALL S2I
         GOTO 1000
C
  340    CALL S3I
         GOTO 1000
C
  350    CALL S4I
         GOTO 1000
C
  360    CALL S5I
         GOTO 1000
C
 1000 CONTINUE
C
C
C---  Run the initialization module for G4. (G4 is not a module but 
C     determines the end of run.  It is executed in STGE3 and not included 
C     in the input list of modules to be executed, therefore the G4I
C     module is not executed so this forces the execution)
C
      CALL G4I
C
C
C---  Check to see if output needs to be generated.  Call the 
C     output controlling module
C
      STGEMET = .FALSE.        ! Output not called after stage met.
      CALL OUPT3( STGEMET )
C
C
      RETURN
      END
      SUBROUTINE AUXSUB
C
C-------------------------------------------------------------------------
C
C  This module controls the calling of the modules selected by the type 
C  2 input cards.
C
C-------------------------------------------------------------------------
C
C  NUMSUB - (I) The number of the module entered on the type 2 card.
C
C-------------------------------------------------------------------------
C
C
      COMMON        C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /PREV/ TPREV, CPPREV, PPPREV
C
      COMMON /KRUN/  JRUN, MULRUN, IGROUP
C
      DIMENSION   XMODNO(99)
C
      EQUIVALENCE (C(2000), TIME      )
      EQUIVALENCE (C(2361), NOMOD     )
      EQUIVALENCE (C(2362), XMODNO(1) )
      EQUIVALENCE (C(2561), NIP       )
      EQUIVALENCE (C(2020), LCONV     )  
      EQUIVALENCE (C(2001), TSTAGE    )
C
      EQUIVALENCE (C(2866), ICOOR )
C
C     Load the C array from the current results of the integration 
C     module
C
      CALL LD_CARRAY( NIP )
C
C
C---  Compute time in stage.
C
      TSTAGE = TIME - TPREV
C
C---  Evaluate all type 11 variables NOT associated with a user module.
C     These values will be used in the subsequent Module calls.
C
      CALL CNTROL( 1, 1 )
C
C
C     Call the modules selected by the type 2 cards.
C
      DO 500 I = 1, NOMOD 
C
C        Lconv = 2 = end of trajectory has been reached; exit this module.
C
         IF( LCONV .GE. 2 ) THEN
C
C           Reset the ISAVE flag is at the end of a set of group runs
C
            IF( JRUN .GE. MULRUN ) ISAVE = 0
C
            RETURN
C
         ENDIF
C
         NUMSUB = XMODNO(I)
C
         GOTO ( 500, 110, 120, 130, 140, 150, 160, 170, 180, 
     1          190, 200, 210, 210, 210, 210, 210, 220, 230, 
     2          240, 250, 260, 270, 280, 290, 300, 310, 320,
     3          330, 340, 350, 360, 380 ),  NUMSUB
C
         WRITE(ID_TABOUT,*) '  GOTOER IN AUXSUB, NUMSUB = ', NUMSUB
C
C
  110    CALL A1      
         GOTO 500
C
  120    CALL A2
         GOTO 500
C   
  130    CALL A3
         GOTO 500
C   
  140    CALL A4
         GOTO 500
C   
  150    CALL A5
         GOTO 500
C   
  160    CALL C1
         GOTO 500
C   
  170    CALL C2
         GOTO 500
C   
  180    CALL C3
         GOTO 500
C   
  190    CALL C4
         GOTO 500
C   
  200    CALL C5
         GOTO 500
C   
  210    CONTINUE
         GOTO 500
C   
  220    CALL D1
         GOTO 500
C   
  230    CALL D2
         GOTO 500
C   
  240    CALL D3
         GOTO 500
C   
  250    CALL D4
         GOTO 500
C   
  260    CALL D5
         GOTO 500
C   
  270    CALL G1
         GOTO 500
C   
  280    CALL G2
         GOTO 500
C   
  290    CALL G3
         GOTO 500
C   
  300    CALL G4
         GOTO 500
C   
  310    CALL G5
         GOTO 500
C   
  320    CONTINUE
         GOTO 500
C   
  330    CALL S1
         GOTO 500
C   
  340    CALL S2
         GOTO 500
C   
  350    CALL S3
         GOTO 500
C   
  360    CALL S4
         GOTO 500
C   
  380    CALL S5
         GOTO 500
C   
  500 CALL CNTROL( 0, NUMSUB )
C
C     NOTE:  The above call evaluates the type 11 functions associated 
C     with particular Modules.  These values will be used the NEXT time 
C     the Modules are called;  These new values are also the ones that 
C     are output on the tabular/plot data files;  the data precedes it's 
C     usage on output.
C   
C
C     Load the integration arrays from the C array:
C
      CALL LD_DERIV( NIP )
C
      RETURN
      END
      SUBROUTINE C1_PROCESS( IR2, ISWTH )
C
C-------------------------------------------------------------------------
C
C    Card type 1 : Module Selection: OUPT3 and STGE3
C    These cards select the modules to be executed AFTER EACH 
C    INTEGRATION STEP.  The selected module numbers are loaded into the 
C    array SUBNO for use in the module that actually calls each module.
C
C    Only two modules are currently available in this version 
C    of CADAC:  #3 = OUPT3 and #4 = STGE3.
C
C    Card Format: 
C      Column       Description
C       1-2         (I) "01" = Card type number
C       4-9         (C) Sub-module Name (Not used)
C       25          (I) Sub-module Number
C
C--Argument List Definitions--------------------------------------------
C
C  IR2   - (I) Input. The second integer input on the card = submodule 
C          number.
C  ISWTH - (I) Output. Input Error flag.
C
C--Local Variable Definitions-------------------------------------------
C
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      DIMENSION   SUBNO(99)
C
      EQUIVALENCE (C(2461), NOSUB    )
      EQUIVALENCE (C(2462), SUBNO(1)  )
C
C
      ICARDTYPE = 1
C
C    Check to insure that there is room in the arrays and the 
C    maximum number of modules has not yet been reached.
C
      IF( NOSUB .EQ. 99 ) THEN
          ISWTH = 1
          CALL OIN1_EMSG( ICARDTYPE )
          RETURN
      ENDIF
C
C     Check for an invalid module number.
C
      IF( IR2 .LE. 0  .OR.  IR2 .GT. 9 ) THEN 
          ISWTH = 1
          CALL OIN1_EMSG( ICARDTYPE )
          RETURN
      ENDIF
C
C
C     Add the module number to the list to be executed.
C
      NOSUB = NOSUB + 1
      SUBNO( NOSUB ) = IR2
C
C 
      RETURN
      END
      SUBROUTINE C2_PROCESS( IR2, ISWTH )
C
C-------------------------------------------------------------------------
C
C  Card type 2:  Module selection cards.  These cards contain the 
C  list of module numbers to be executed, in the order of execution.  
C  Load the module numbers into the array for selection by the module 
C  that controls module exeuction.
C
C    Card Format: 
C      Column       Description
C        1-2         (I) "02" = Card type number
C        3-20        (C) Submodule Name (Not used)
C       21-25        (I) Sub-module  Number
C
C--Argument List Definitions--------------------------------------------
C
C  IR2   - (I) Input. The second integer input on the card = sub-module 
C          number.
C  ISWTH - (I) Output. Input Error flag.
C
C--Local Variable Definitions-------------------------------------------
C
C  ICARDTYPE - (I) The card type that is currently being processed.
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      DIMENSION   XMODNO(99)
C
      EQUIVALENCE (C(2361), NOMOD    )  
      EQUIVALENCE (C(2362), XMODNO(1) ) 
C
C     NOMOD = The number of modules to be executed (as input by user)
C     XMODNO(1) = The number of the module to be executed. 
C
C
      ICARDTYPE = 2
C
C     Check to see if the max. number of modules has been reached.
C
      IF( NOMOD .EQ. 98 ) THEN
          ISWTH = 2
          CALL OIN1_EMSG( ICARDTYPE )
          RETURN
      ENDIF
C
C     Check for an invalid module number
C
      IF( IR2 .LE. 0  .OR.  IR2 .GT. 37 ) THEN
          ISWTH = 2
          CALL OIN1_EMSG( ICARDTYPE )
          RETURN
      ENDIF
C
C
C     Add the module to the list.
C         
      NOMOD = NOMOD + 1
      XMODNO( NOMOD ) = IR2
C
C
      RETURN
      END
      SUBROUTINE C7_PROCESS( IR2, MODE, VR, NSTAGE, ISWTH )
C
C-------------------------------------------------------------------------
C
C  Card type 7 : VECTOR Variable initialization Card.  These cards 
C  allow values to be assigned to VECTORS in the C common variable.
C
C    Card Format: 
C      Column       Description
C        1-2         (I) "07" = Card type number
C        3-8         (C) Variable Name (Documentation use only)
C        9-14        (C)
C       21-25        (I) Variable Number of first element
C       26-30        (I) Variable Initialization Flag (MODE)
C       31-45        (R) if MODE = 1;  value of all elements.
C       46-60        (R) SET by CADAC;  Points to the location in
C                        the storage array to the data.
C       61-62        (I) Stage number for multi run cases.
C
C--Argument List Definitions--------------------------------------------
C
C  IR2    - (I) Input. The second integer input on the card = submodule 
C               number.
C  VR(I)  - (R) Input. The two real values input on the card. 
C  MODE   - (I) Input. The number of variables in the array as a + or - 
C               value as a flag for variable initialization. 
C  NSTAGE - (I) Input.  The number of the stage currently being 
C               processed.
C  ISWTH  - (I) Output. Input Error flag.
C
C--Local Variable Definitions-------------------------------------------
C
C  ICARDTYPE - (I) The card type that is currently being processed.
C
C-------------------------------------------------------------------------
C
C
      COMMON /C7WKD/  IWC7S0, WC7S0(10,20), IWC7SN(20), WC7SN(20,5,20)
C 
      COMMON  C(3510)
C
C
      DIMENSION VR(2)     
C
C
      ICARDTYPE = 7
C
C
C     Check for an invalid variable number (C location) to be 
C     initialized.
C
      IF( IR2 .LE. 0  .OR.  IR2 .GT. 3510 ) THEN
          ISWTH = 7
          CALL OIN1_EMSG( ICARDTYPE )
          RETURN
      ENDIF
C
C
      IF( MODE .GT. 0 ) THEN
C
C         Initialize the elements to individual values. 
C
          ISET = INT( VR(2) )
C 
          IF( NSTAGE .LT. 1 ) THEN 
C
              DO I = 1, MODE
                 C( IR2 + ( I-1 ) ) = WC7S0( ISET, I )
              ENDDO
C
          ELSE
C 
              DO I = 1, MODE
                 C( IR2 + ( I-1 ) ) =  WC7SN( NSTAGE, ISET, I )
              ENDDO
          ENDIF
C
      ELSE
C
C         Mode < 0:  Initialize elements to same value.
C
          NELEMENTS = ABS( MODE )
C
          DO I = 1, NELEMENTS
             C( IR2 + ( I-1 ) ) = VR(1)
          ENDDO
C
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE C8_PROCESS
C
C-------------------------------------------------------------------------
C
C   Card type 8 : Read and set up weather data.  Display the data to 
C   the output file.
C
C
C    Card Format: 
C      Column       Description
C        1-2         (I) "08" = Card type number
C
C    Card Format of following weather deck (Max of 50 cards):
C        Free field format on each record with the information in the 
C        following order (values must be entered for all parameters): 
C             Altitude (Ft-ASL), Wind direction (Deg), 
C             Wind Velocity (Ft/Sec), Density (Slugs/Ft**3), 
C             Temperature (Deg F), Pressure (Lb/Ft**2)
C
C   Metric units are respectively: ( M-ASL), (Deg), (M/Sec), (Kg/M**3),
C             (Deg C), (Pascals)
C
C
C--Local Variable Definitions-------------------------------------------
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /WINDS/  WALT(50), WDIR(50), WVEL(50), RHX(50),
     1                CTMP(50), WPRES(50), KOUNTW, RHW
C
      COMMON /WSETWT/ WX(6,50)
C
C
      EQUIVALENCE (C(0053), OPTMET    )
C
C
C---  Write the weather headers:
C
      WRITE(ID_TABOUT,440)
  440 FORMAT( / '****  WEATHER DATA  ****', //
     1          '   ALTITUDE ', '  WIND DIR  ', '  WIND VEL  ',
     2          '  DENSITY   ',  '  TEMPRTR   ', '  PRESSURE  ' )  
C
C
      IF( OPTMET .LT. 1.0 ) THEN 
C
C         English units - write appropriate headers.
C             
          WRITE(ID_TABOUT,460) 
  460     FORMAT( '  FEET,MSL  ', '  DEGREES   ', '  FT/SEC   ',
     1            '  SLG/FT**3 ',  '  DEG FAR   ', '  LB/FT**2  ' )
C
      ELSE
C
C         Metric Units - Write appropriate headers.
C
          WRITE(ID_TABOUT,500) 
  500     FORMAT(  '  METERS,MSL', '  DEGREES   ', '  METERS/SEC',
     1             '  KG/M**3   ',  '  DEG CENT  ', '  PASCALS   ' )
C
      ENDIF
C
C
C     Load the working arrays from the data input arrays.
C
      DO I = 1, KOUNTW
         WALT(I)  = WX(1,I)
         WDIR(I)  = WX(2,I)
         WVEL(I)  = WX(3,I)
         RHX(I)   = WX(4,I)
         CTMP(I)  = WX(5,I)
         WPRES(I) = WX(6,I)
C
         RHW   = WALT(I)
C                           
         WRITE(ID_TABOUT,540)
     1   WALT(I),WDIR(I),WVEL(I),RHX(I),CTMP(I),WPRES(I)
  540    FORMAT( 1X, 1P6E12.3 )  
C         
      ENDDO
C
      WRITE(ID_TABOUT,*) '   '
      WRITE(ID_TABOUT,*) '****  END OF WEATHER DATA  ****'
      WRITE(ID_TABOUT,*) '   '
C
C
      RETURN
      END
      SUBROUTINE C9_PROCESS( IR2 )
C
C-------------------------------------------------------------------------
C
C  Header cards.  This module allows up to 5 cards of text data to be 
C  entered and displayed on the output. 
C
C    Card Format: 
C      Column       Description
C        1-2         (I) "09" = Card type number
C        25          (I) Number of header cards that follow ( N <= 5) 
C
C    Header Card Format:
C      Column       Description
C      1-80         (C) Text to be saved and displayed.
C
C--Argument List Definitions--------------------------------------------
C
C  IR2   - (I) Input. The second integer input on the card = Number of 
C          header cards following.
C
C-------------------------------------------------------------------------
C
      COMMON /COLLER/ HOL(5)
      CHARACTER       HOL*80
C
      COMMON /WSETC/  AL(3,500), HOLL(5)
      CHARACTER       AL*6,      HOLL*80
C
C
      NUMHOL = IR2
C
      DO IX = 1, NUMHOL
         HOL(IX) = HOLL(IX)
      ENDDO
C
C
      RETURN
      END
      SUBROUTINE C10_PROCESS( IR2, ISWTH )
C
C-------------------------------------------------------------------------
C
C  This module process the data entered on the record(s) following a type 10 
C  card.  This record contains the conditions for staging.  A maximum of 
C  two staging tests/variables/records may be entered.
C
C-------------------------------------------------------------------------
C
C  IR2 - (I) Input. The number of staging tests/variables entered on the 
C            type 10 card.
C  ISWTH - (I) Output.  Error flag set as necessary by this module.
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
C
      COMMON /STAGE/   LOC(2), INCRS(2), VAL(2), UNITS(2), KODE(2), 
     1                 TEST(2), LOCT(2), NTEST
C
      COMMON /STAGE1/  ISTAGE, NUMSTAGE
C
      COMMON /STAGEC/  NAME1(2), NAME2(2)
      CHARACTER        NAME1*6, NAME2*6
C
      COMMON /WSETSC/  MCRI(20,2,4), WVAL(20,2)
C
      COMMON /WSETSCC/ MCRIC(20,2,2)
      CHARACTER        MCRIC*6
C
C
C
      NTEST  = IR2
      IF( NTEST .NE. 1  .AND.  NTEST .NE. 2 ) NTEST = 1
C
C     Increment stage number
C
      NUMSTAGE = NUMSTAGE + 1
C
      DO I = 1, NTEST
C
C            Transfer staging criteria data to the actual working arrays.
C
             NAME1(I) = MCRIC( NUMSTAGE, I, 1 )   ! Stage Variable Name
             LOC(I)   = MCRI( NUMSTAGE, I, 1 )    ! C Element location
             INCRS(I) = MCRI( NUMSTAGE, I, 2 )    ! Flag
             NAME2(I) = MCRIC( NUMSTAGE, I, 2 )   !
             VAL(I)   = WVAL( NUMSTAGE, I )       ! Real data value
             UNITS(I) = MCRI( NUMSTAGE, I, 3 )    ! ?
             KODE(I)  = MCRI( NUMSTAGE, I, 4 )    ! Kode flag
C
C            Check for an invalid C element location
C
             IF( LOC(I) .LE. 0 .OR. LOC(I) .GT. 3510 ) ISWTH = 10 
C
C            Check for an invalid staging flag
C
             IF( IABS( INCRS(I) ) .GT. 1 ) ISWTH = 10
C
C            Check for an invalid KODE flag:
C
             IF( KODE(I) .GT. 1 ) ISWTH = 10
C
             IF( KODE(I) .EQ. 1 ) THEN 
C
C                VAL contains a C element location.
C                Check for invalid C element location
C               
                 IF( VAL(I) .LT. 1.0  .OR.  VAL(I) .GT. 3510.0 ) 
     1               ISWTH = 10
             ENDIF
C
C
             L = LOC(I)    ! C element location of the staging variable
C
             IF( KODE(I) .LT. 0 ) THEN 
C
C                Add the value VAL to the current contents of the C 
C                element location specified in LOC.  During simulation, 
C                this sum, TEST, is compared to the contents of the 
C                element specified in LOC to determine staging.
C
                 TEST(I) = C(L) + VAL(I)
C
             ELSEIF( KODE(I) .GT. 0 ) THEN 
C
C                The contents of the C element location is to be used as 
C                the staging criteria. 
C
                 LOCT(I) = VAL(I)
C
             ELSE
C
C                The value, VAL, is to be used as the stage criteria
C
                 TEST(I) = VAL(I)
C
             ENDIF
C
C            If time is the staging variable, decrease the test value 
C            slightly.
C            
             IF( L .EQ. 2000 ) TEST(I) = TEST(I) - 0.000001
C
      ENDDO
C
C
      RETURN
      END
      SUBROUTINE C11_PROCESS( IR2, ALPHA, VR, ISWTH, IR3 )
C
C-------------------------------------------------------------------------
C  This module performs the processing for data input with card type 
C  11.
C
C    Card Format: 
C      Column       Description
C       1-2         (I) "11" = Card type number
C       3-8         (C) Name of the controlled variable (Not used)
C       9           (C) Combination Code.  Must be either: ' ', '=', 
C                       '+', '*', '-'
C       10-14       (C) Name of function
C       15-20       (C) Not used
C       21-25       (I) C Element number of the controlled variable. IR2
C       26-30       (I) Activated under task SEU 91-02 - Definition 
C                       depends on the function's definition.  Not 
C                       used for most functions. IR3
C       31-45       (R) 1st parameter.  If zero or blank, the current 
C                       value will be used.
C       46-60       (R) 2nd parameter.
C
C
C--Argument List Definitions--------------------------------------------
C
C  IR2      - (I) Input. The second integer input on the card = 
C              controlled variable number. 
C  ALPHA(3) - (C) Input. All of the character data input on the card 
C             type 11
C  VR(2)    - (R) Input. Both real variables input on the card.
C  ISWTH    - (I) Output. Input Error flag.
C  IR3      - (I) Input. The third integer input on the card.  Use 
C             depends on the function definition.
C
C--Local Variable Definitions-------------------------------------------
C
C  CCODE(5)  - (C1) The combination codes in character format.
C  CHRCODE   - (C1) The character code entered by the user.
C  CHRFUNCT  - (C5) The function type entered by the user in character 
C              format.
C  FUNCT(14) - (C5) The keywords for the available function types.
C  ICARDTYPE - (I) The card type that is currently being processed.
C  ICODE     - (I) The combination code deciphered and in integer 
C              format.
C  NUMFUNCT  - (I) The maximum number of available functions.  Also the 
C              array size of FUNCT.
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      COMMON /CCOM/ ICF(25), ICC(25), ICL(25), CA(25), 
     1              CL(25), CT0(25), NC, ICL2(25)
C
C
      EQUIVALENCE (C(2000), TIME )
C
      DIMENSION VR(2)
C
      CHARACTER ALPHA(3)*6, CHRCODE*1, CHRFUNCT*5, FUNCT(15)*5, 
     1          CCODE(5)*1
C
C
      DATA CCODE/ ' ',  '=',  '+',  '-',  '*'  /, 
     2     FUNCT/ 'STEP ', 'RAMP ', 'PARAB', 'SIN  ', 'COS  ',
     3            'TRI  ', 'GAUSS', 'UNIF ', 'DECAY', 'SQR  ',
     4            'SUM  ', 'PROD ', 'DIFF ', 'RAYLE', 'EQUAL'  /, 
     5     NUMFUNCT/ 15 /
C
C
C
      ICARDTYPE = 11
C
C
C---  Parse the combination code and the type function from the input 
C     character string.
C
      CHRCODE = ALPHA(2)(1:1)
      CHRFUNCT = ALPHA(2)(2:6)
C
C
      IF( CHRFUNCT .EQ. 'END  ' ) THEN
C
C         END function selected - Deactivate all control functions
C
          NC = 0
C
          RETURN
      ENDIF
C
C
C---  Check for an invalid C element location entered in IR2
C
      IF( IR2 .LE. 0  .AND.  IR2 .GT. 3510 ) THEN
          ISWTH = 11
          CALL OIN1_EMSG( ICARDTYPE ) 
          RETURN 
      ENDIF
C
C
C---  Determine the combination code. 
C
      ICODE = 0
      DO  I = 1, 5
          IF( CHRCODE .EQ. CCODE(I) ) ICODE = I
      ENDDO
C
      IF( ICODE .EQ. 0 ) THEN
C     
C         Invalid combination code entered.
C     
          ISWTH = 11
          CALL OIN1_EMSG( ICARDTYPE ) 
          RETURN
      ENDIF
C
C
C---  Determine the function type.
C
      IFUNCT = 0
      DO I = 1, NUMFUNCT
         IF( CHRFUNCT .EQ. FUNCT(I) ) IFUNCT = I
      ENDDO
C
      IF( IFUNCT .EQ. 0 ) THEN
C
C         Invalid function type - Exit the module with an error message.
C
          ISWTH = 11
          CALL OIN1_EMSG( ICARDTYPE ) 
          RETURN
      ENDIF
C
C
      IF( IFUNCT .GT. 10  .AND.  IFUNCT .LT. 14 ) THEN 
C
C         Sum, Diff or Prod functions were selected.  The last two Real 
C         variables input must contain C element locations.  Insure that
C         valid C locations are entered in these variables.
C
          DO I = 1, 2
             IF( VR(I) .LE. 0.0  .OR.  VR(I) .GT. 3510.0 ) THEN
                 ISWTH = 11
                 CALL OIN1_EMSG( ICARDTYPE ) 
                 RETURN
              ENDIF
          ENDDO
C
      ELSEIF( IFUNCT .EQ. 15 ) THEN 
C
C         The equal function was selected.  The first Real variable 
C         input must contain a C element location.  Insure that
C         a valid C locations is entered. 
C
          IF( VR(1) .LE. 0.0  .OR.  VR(1) .GT. 3510.0 ) THEN
              ISWTH = 11
              CALL OIN1_EMSG( ICARDTYPE ) 
              RETURN
          ENDIF
      ENDIF
C
C---
C
      IF( NC .EQ. 25 ) THEN
C
C         Maximum number of functions have been defined.  Don't allow 
C         any more definitions.  Give error message and return.
C
          ISWTH = 11
          CALL OIN1_EMSG( ICARDTYPE ) 
          RETURN
      ENDIF
C
C
C---  Valid data has been input.  Define the functions.
C
      NC      = NC + 1      ! Increment the number of defined functions.
C
C     Store the input data in their respective arrays:
C
      ICF(NC) = IFUNCT      ! Function Type
      ICC(NC) = ICODE       ! Combination Code
      ICL(NC) = IR2         ! Controlled variable
      ICL2(NC) = IR3        ! Integer parameter 
C
C     Store the first variable or, if 0.0 was entered, save the current 
C     value of the controlling variable.
C
      CA(NC)  = VR(1)       ! 1st parameter
      IF( CA(NC) .EQ. 0.0  )  CA(NC) = C( IR2 )
C
      CL(NC)  = VR(2)       ! 2nd parameter
      CT0(NC) = TIME        ! Current time at function definition
C
C
      IF( IFUNCT .EQ. 7 ) THEN
C
C         GAUSS function selected - initialize CT0 to 0.0 and apply the 
C         negative to the beta at this point.  A = EXP( -Beta * DT)
C         where Beta is the 2nd parameter input.
C
          CT0(NC) = 0.0
          CL(NC)  =  - ABS( CL(NC) )
C
      ELSEIF( IFUNCT .EQ. 14 ) THEN
C
C         RAYLE function selected - The integer parameter is the number 
C         of integration intervals the value of the function is to be 
C         maintained (ie like a step width).  Insure that this variable 
C         is greater than zero. If the variable is zero, force a 
C         default value of 5.
C
          IF( ICL2(NC) .LE. 0.0 ) ICL2( NC ) = 5  
C
C         Also set the CT0 definition for this function.  CT0 is the 
C         time where the next obstical is to be encountered = Current 
C         time at function definition + delta time until the next obstical 
C         is encountered.
C
          EMEAN = CA(NC)            ! 1st parameter
          DELTOBS = EXPON( EMEAN )  ! Time between obsticals in seconds.
C
C         Add this to the current time already stored in Ct0.
C
          CT0( NC ) = CT0( NC ) + DELTOBS
C  
      ELSEIF( IFUNCT .EQ. 15 ) THEN
C
C         EQUAL function - Go ahead and set the initial value of 
C         this function.  This is to prevent the function from having an 
C         incorrect value during the time between the function's initiation 
C         and the first function evaluation.
C
          K1 = VR(1)               ! Intergerize the element number
          C( IR2 ) = C( K1 )       ! Get the current value.
C
C
      ENDIF
C
C
C
      RETURN
      END
      SUBROUTINE C90_PROCESS
C
C-------------------------------------------------------------------------
C
C   Type 90 card stores state on file -tape90-
C   Type 91 card restores state from file -tape90-
C   Routine loaded inline.
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /NAD/     IBEEN, IBEGIN, ICARD, ISAVE
C
      COMMON /OINDAT/  J16, ICD, I16
C
      COMMON /STAGE1/  ISTAGE, NUMSTAGE
C
      DIMENSION IC(3510)
      EQUIVALENCE (C(0001), IC(0001) )
C---
C------------------------PC Code-------------------------------------
C---
      OPEN( ID_CSAVE, FILE='CSAVE.ASC', STATUS='UNKNOWN' )
      WRITE(ID_CSAVE,*) C, IC
C
      CLOSE( ID_CSAVE )
C
C--------------------------------------------------------------------
C
C     Write a message to the output file.
C
      WRITE(ID_TABOUT,*) ' WRITE ON CSAVE.ASC '  ! TAPE90 '
C
C     End routine loaded inline.
C     Store the stage number where the save occurred, save the card number
C     and set the save flag  
C
      IBEGIN = NUMSTAGE     
      ICARD  = ICD
      ISAVE  = 1
C
C
      RETURN
      END
      SUBROUTINE COMPRT
C
C-------------------------------------------------------------------------
C
C
C-------------------------------------------------------------------------
C
      COMMON      C(3510)
C
      RETURN
      END
      SUBROUTINE CNTROL( J1, J2 )
C
C-------------------------------------------------------------------------
C
C  This module  contains the type 11 card implementation.
C  Type 11 cards are used by the analyst to define forcing functions, 
C  superimpose noise on selected variables, and combine selected 
C  variables.
C  This module is called after each integration and prior to the calls 
C  to the modules to update the value of the variable (in accordance 
C  with the defined function) for the current time.
C
C--Argument List Definitions--------------------------------------------
C
C  J1 - (I) 1 at call prior to modules in auxsub; 0 in call after 
C       modules in auxsub.
C  J2 - (I) submodule number.
C
C--Local Variable Definitions-------------------------------------------
C
C  SAV_VALUE(25) - (R) An array for saving the computed GAUSS, UNIF or 
C                  RAYLE values at the predictor stage (ICOOR = 0) or 
C                  initialization (ICOOR = -1) and 
C                  then re-loading these same values at the corrector 
C                  stage (ICOOR=1).  HOWEVER, a discrepancy exists
C                  due to the type 11, module-associated C locations 
C                  are computed AFTER the module, and the value is actually 
C                  for the NEXT module call.  So for these variables, 
C                  this needs to switch
C
C-------------------------------------------------------------------------
C
C
      COMMON        C(3510)
C
      COMMON /CCOM/ ICF(25), ICC(25), ICL(25), CA(25), 
     1              CL(25), CT0(25), NC, ICL2(25)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C
      DIMENSION DER(101)
C
      EQUIVALENCE (C(2000), TIME   )   
      EQUIVALENCE (C(2664), DER(1) ) 
      EQUIVALENCE (C(2866), ICOOR )
C
C     TIME   = The current time in the integration process
C     DER(1) = The Integration step size
C     ICOOR  = FLAG: 0 = Prediction cycle of integrator; 1 = Correction 
C              cycle;  -1 = Initialization cycle.
C
      INTEGER   LL(37), UL(37)
      DIMENSION SAV_VALUE( 25 ) 
C
C
C---  The two following data cards may require an update if: 
C
C          1.  A module different than those listed in "AUXSUB" is added.
C          2.  The storage bounds of a module are altered,
C              i.e. storage locations for module s2 are 600-749
C              instead of the old locations  600-699.
C
C--- The storage locations below are sequenced to match the module
C    number, NOSUB, as follows: 
C    Nosub     Name Locations
C    1               1-99 = Unassigned module number = Executive ?
C    2    A1   1200-1299
C    3    A2   1300-1399
C    4    A3   1400-1499
C    5    A4   1500-1599
C    6    A5   Dummy module - no commons assigned.
C    7    C1   800-899
C    8    C2   900-999
C    9    C3   1000-1099
C    10   C4   1100-1199
C    11   C5   Dummy module - no commons assigned.
C    12   C6   Dummy module - no commons assigned.
C    13   C7   Dummy module - no commons assigned.
C    14   C8   Dummy module - no commons assigned.
C    15   C9   Dummy module - no commons assigned.
C    16   C10  Dummy module - no commons assigned.
C    17   D1   1600-1699
C    18   D2   1700-1799
C    19   D3   1800-1899  ? Growth module
C    20   D4   1900-1999  ? Debug module
C    21   D5   Dummy module - no commons assigned.
C    22   G1   100-199
C    23   G2   200-299
C    24   G3   300-399
C    25   G4   Dummy module - no commons assigned.
C    26   G5   Dummy module - no commons assigned.
C    27
C    28   S1   400-499
C    29   S2   500-599
C    30   S3   600-699
C    31   S4   700-799
C    32   S    Dummy module - no commons assigned.
C    34   S6   Dummy module - no commons assigned.
C    35   S8   Dummy module - no commons assigned.
C    36   S9   Dummy module - no commons assigned.
C    37        Dummy module - no commons assigned.
C
C
      DATA LL/    1, 1200, 1300, 1400, 1500,    0,  800,  900,  
     1         1000, 1100,    0,    0,    0,    0,    0,    0, 
     2         1600, 1700,    0,    0,    0,  100,  200,  300,
     3            0,    0,    0,  400,  500,  600,  700,    0,
     4            0,    0,    0,    0,    0/
C
C     Ending C element location for initialization:
C
      DATA UL/   99, 1299, 1399, 1499, 1599,    0,  899,  999, 
     1         1099, 1199,    0,    0,    0,    0,    0,    0,
     2         1699, 1799,    0,    0,    0,  199,  299,  399,   
     3            0,    0,    0,  499,  599,  699,  799,    0,   
     4            0,    0,    0,    0,    0 /
C
C
C
C---  If no forcing functions are defined, then exit the module.
C
      IF( NC .LE. 0 ) RETURN
C
C
C     For each defined forcing function: 
C
      DO I = 1, NC
C
C        IV = The variable (C location) being controlled by a function
C
         IV = ICL(I)
C
C
C         Original coding:  This block was left for reference but
C         recoded in a more structured/understandable format.
C         IF( J1 .EQ. 0   .OR.   IV .LE. 1799 ) THEN 
C            Cntrol is being called after a module has been executed.
C            Check if the type 11 controlled variable is a part of that
C            module.  If it is outside the module's common area, then 
C            skip the function update. 
C             IF( IV .LT. LL(J2)  .OR.  IV .GT. UL(J2) ) GOTO 1000
C         ENDIF
C
         IF( J1 .EQ. 0 ) THEN
C
C            Called after a module is executed :
C
C            Evaluate the function if the common location is assigned to 
C            the module just executed.  If the common location is 
C            outside this range, then skip the function evaluation
C
             IF( IV .LT. LL(J2)  .OR.  IV .GT. UL(J2) ) GOTO 1000
C
         ELSE 
C
C            J1 = 1 : Called prior to evaluation of any modules:
C
C            If the common location is outside the ranges 
C            1799-3510  AND  1-99  then skip the function evaluation.
C            
             IF( IV .LT. LL(J2)  .OR.  IV .GT. UL(J2) ) THEN
C
C                Common location is outside the range 1-99
C 
                 IF( IV .LT. 1799 .OR.  IV .GT. 3510 ) GOTO 1000
             ENDIF
C
         ENDIF
C
C
C        Load the function information into local variables for 
C        computations:
C
         IC = ICC(I)          ! Combinaton code
         TC = TIME - CT0(I)   ! Delta time since definition
         A = CA(I)            ! 1st parameter
         B = CL(I)            ! 2nd parameter
         IP2 = ICL2( I )      ! Second optional integer parameter.
         KF = ICF(I)          ! Forcing function
C
C
C        Branch to the code for the selected function :
C
         GOTO ( 110, 120, 130, 140, 150, 160, 170, 180, 
     1          190, 200, 210, 210, 210, 220, 230 ), KF
C
C
         WRITE(ID_TABOUT,*) '  GOTOER IN CONTROL, KF = ', KF
C
C
  110    CONTINUE 
C
C---     Step function
C
         XVALUE = A
         GOTO 900
C
C
  120    CONTINUE
C
C---     Ramp function
C
         XVALUE  = B * TC
C
C        Insure that  -A <= XVALUE <= A
C
         AA = ABS(A)
         XVALUE = AMAX1( -AA, AMIN1( AA, XVALUE ) )
         GOTO 900
C
C
  130    CONTINUE
C
C---     Parabola function
C
         XVALUE = B * TC * TC
C
C        Insure that  -A <= XVALUE <= A
C
         AA = ABS(A)
         XVALUE  = AMAX1( -AA, AMIN1(AA, XVALUE ) )
         GOTO 900
C
C
  140    CONTINUE
C
C---     Sine function
C
         XVALUE = A * SIN( 6.2831853 * TC / B )
         GOTO 900
C
C
  150    CONTINUE
C
C---     Cosine Function
C
         XVALUE = A * COS( 6.2831853 * TC / B )
         GOTO 900
C
C
  160    CONTINUE
C
C---     Triangular wave function
C
         XVALUE = TRI( A, B, TC )
         GOTO 900
C
C
  170    CONTINUE
C
C--      Gaussian Noise
C
C         Code added under XR92 to insure that the same Xvalue is used 
C         at both predictor and corrector cycles.
C
         IF( J1 .NE. 1 ) THEN 
C
C            The C location is associated with a module - the computation 
C            occurrs at ICOOR = N but is used within the modules at 
C            ICOOR = N+1
C
             IF(  ICOOR .GT. 0 .OR.  ICOOR .EQ. -1 ) THEN 
C
C                 Modules are in Correction Cycle or Initialization,
C                 but the values generated NOW will be used for the 
C                 Predictor Cycle.  Therefore save these values.
C
                  CALL CNT_GAUSS( A, B, TIME, DER(1), CT0(I), XVALUE ) 
                  SAV_VALUE(I) = XVALUE
C                   
             ELSE
C
C                 Modules are in Prediction Cycle but the values loaded 
C                 NOW will be used in the Corrector Cycle.
C
                  XVALUE = SAV_VALUE( I )
             ENDIF
C
         ELSE
C
C            The C locations NOT associated with a module are being 
C            evaluated.  These are evaluated PRIOR to executing any 
C            modules therefore ICOOR will have the same value during 
C            evaulation and when the module is using the value.
C
             IF(  ICOOR .LT. 1 ) THEN 
C
C                 Modules are in Prediction Cycle or initialization.  
C                 Values generated NOW will be used for the Predictor 
C                 Cycle module execution.  Therefore save these values.
C
                  CALL CNT_GAUSS( A, B, TIME, DER(1), CT0(I), XVALUE ) 
                  SAV_VALUE(I) = XVALUE
C                   
             ELSE
C
C                 Modules are in CORRECTION Cycle.  The values loaded 
C                 NOW will be used in the Corrector Cycle.
C
                  XVALUE = SAV_VALUE( I )
             ENDIF
C
         ENDIF
C
         GOTO 900 
C
C
  180    CONTINUE
C
C---     Uniform function
C
         IF( J1 .NE. 1 ) THEN 
C
C            The C location is associated with a module - the computation 
C            occurrs at ICOOR = N but is used within the modules at 
C            ICOOR = N+1
C
             IF(  ICOOR .GT. 0 .OR.  ICOOR .EQ. -1 ) THEN 
C
C                 Modules are in Correction Cycle or Initialization,
C                 but the values generated NOW will be used for the 
C                 Predictor Cycle.  Therefore save these values.
C
                  XVALUE        = UNIF( A, B )
                  SAV_VALUE( I ) = XVALUE
C                   
             ELSE
C
C                 Modules are in Prediction Cycle but the values loaded 
C                 NOW will be used in the Corrector Cycle.
C
                  XVALUE = SAV_VALUE( I )
             ENDIF
C
         ELSE
C
C            The C locations NOT associated with a module are being 
C            evaluated.  These are evaluated PRIOR to executing any 
C            modules therefore ICOOR will have the same value during 
C            evaulation and when the module is using the value.
C
             IF(  ICOOR .LT. 1 ) THEN 
C
C                 Modules are in Prediction Cycle or initialization.  
C                 Values generated NOW will be used for the Predictor 
C                 Cycle module execution.  Therefore save these values.
C
                  XVALUE        = UNIF( A, B )
                  SAV_VALUE(I) = XVALUE
C                   
             ELSE
C
C                 Modules are in CORRECTION Cycle.  The values loaded 
C                 NOW will be used in the Corrector Cycle.
C
                  XVALUE = SAV_VALUE( I )
             ENDIF
C
         ENDIF
C
         GOTO 900 
C
C
  190    CONTINUE
C
C---     Decay function
C
         XVALUE = DECAY( A, B, TC )
         GOTO 900
C
C
  200    CONTINUE
C
C---     Square wave function
C
         XVALUE = SQR( A, B, TC )
         GOTO 900
C
C
  210    CONTINUE
C
C---     Summing, product, and difference functions.  A and B contain 
C        the C element locations of the variables to be summed, multiplied 
C        or differenced. 
C
         K1 = A + 0.5
         K2 = B + 0.5
C
         IF( KF .EQ. 11 ) THEN
C
             XVALUE = C(K1) + C(K2)       ! Sum
C
         ELSEIF( KF .EQ. 12 ) THEN
C
             XVALUE = C(K1) * C(K2)       ! Product
C
         ELSEIF( KF .EQ. 13 ) THEN
C
             XVALUE = C(K1) - C(K2)       ! Differenced
C
         ENDIF
C
         GOTO 900
C
C
C
  220    CONTINUE
C
C---     Special Rayleigh function added for Dr. Zipfel under task   
C        SEU 91-2
C
         IF( J1 .NE. 1 ) THEN 
C
C            The C location is associated with a module - the computation 
C            occurrs at ICOOR = N but is used within the modules at 
C            ICOOR = N+1
C
             IF(  ICOOR .GT. 0 .OR.  ICOOR .EQ. -1 ) THEN 
C
C                 Modules are in Correction Cycle or Initialization,
C                 but the values generated NOW will be used for the 
C                 Predictor Cycle.  Therefore save these values.
C
                  CALL CNT_RAYLE( A, B, TIME, CT0(I), IP2, DER(1), 
     1                            I, XVALUE  ) 
                  SAV_VALUE( I ) = XVALUE
C                   
             ELSE
C
C                 Modules are in Prediction Cycle but the values loaded 
C                 NOW will be used in the Corrector Cycle.
C
                  XVALUE = SAV_VALUE( I )
             ENDIF
C
         ELSE
C
C            The C locations NOT associated with a module are being 
C            evaluated.  These are evaluated PRIOR to executing any 
C            modules therefore ICOOR will have the same value during 
C            evaulation and when the module is using the value.
C
             IF(  ICOOR .LT. 1 ) THEN 
C
C                 Modules are in Prediction Cycle or initialization.  
C                 Values generated NOW will be used for the Predictor 
C                 Cycle module execution.  Therefore save these values.
C
                  CALL CNT_RAYLE( A, B, TIME, CT0(I), IP2, DER(1), 
     1                            I, XVALUE  ) 
                  SAV_VALUE(I) = XVALUE
C                   
             ELSE
C
C                 Modules are in CORRECTION Cycle.  The values loaded 
C                 NOW will be used in the Corrector Cycle.
C
                  XVALUE = SAV_VALUE( I )
             ENDIF
C
         ENDIF
C
         GOTO 900 
C
C
  230    CONTINUE
C
C------  Function number 15 - equality function.  The controlled 
C        variable is assigned the current value of a user selected C 
C        element.
C
         K1 = A              ! Intergerize the element number
         XVALUE = C( K1 )    ! Get the current value.
C
         GOTO 900
C
C
C
  900    CONTINUE
C
C---     Combine with the controlled variable depending on the 
C        combination code.
C
         IF( IC .LE. 2 ) THEN
C 
C            ' ' or '=' combination code: Replace C with XVALUE
C
             C(IV) = XVALUE
C
         ELSEIF( IC .EQ. 3 ) THEN
C
C            '+' combination code - Add XVALUE to C
C
             C(IV) = C(IV) + XVALUE
C
         ELSEIF( IC .EQ. 4 ) THEN
C
C            '-' combination code - Subtract XVALUE from C
C
             C(IV) = C(IV) - XVALUE
C
         ELSEIF( IC .EQ. 5 ) THEN
C
C            '*' combination code - Multiply XVALUE and C
C
                 C(IV) = C(IV) * XVALUE
         ENDIF
C
C
 1000    CONTINUE   ! Go check the next function.
C
      ENDDO
C
C
      RETURN
      END
      SUBROUTINE CNT_GAUSS( ASIG, BTCOR, TIME, DER, CT0I, XVALUE ) 
C
C-------------------------------------------------------------------------
C
C  This module performs the calculation for a time-correlated Gaussian 
C  stochastic variable for TYPE 11 CARD function.  This module is called 
C  by the CNTROL module
C
C--Argument List Definitions--------------------------------------------
C
C  ASIG  - (R) Input.  The sigma for the gaussian stochastic variable 
C          forming the basis of the time correlated Gauss for type 11.
C  BTCOR - (R) Input.  The Beta time correlation coefficient.  This is 
C          normally a negative value and therefore is negated in the 
C          C11_PROCESS module.
C  TIME  - (R) Input.  The current time.
C  DER   - (R) Input.  The time step size.
C  CT0I  - (R) In/Out.  The previous value generated for the function.
C  XVALUE - (R) Out.  The current value generated for the function.
C
C-------------------------------------------------------------------------
C
C
      XVALUE = GAUSS( ASIG, 0.0 )
C
C     Apply time correlation
C
      IF( TIME .EQ. 0.0 ) THEN 
          CT0I = XVALUE
C
      ELSE
C
          IF( BTCOR .NE. 0.0 ) THEN 
C
C             NOTE:  BTCOR  has already been negated during the 
C             C11_PROCESS module.  
C
              D = EXP( BTCOR * DER )
              DSQRD  = D * D
C
              XVALUE = XVALUE * SQRT( 1.0 - DSQRD ) + CT0I * D
C
              CT0I = XVALUE
          ENDIF
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE CNT_RAYLE( ALAMBDA, RMODE, TIME, CT0I, IP2, DER, 
     1                      NFUNCT, XVALUE) 
C
C-------------------------------------------------------------------------
C
C  Special Rayleigh function added for Dr. Zipfel under task   
C  SEU 91-02.   
C
C--Argument List Definitions--------------------------------------------
C
C  ALAMBDA   - (R) Input. Exponential parameter (lambda = A )
C  RMODE     - (R) Input. Rayleigh mode parameter ( B ) 
C  TIME      - (R) Input. The current trajectory time. 
C  CT0I      - (R) Input. The time at initiation of the function?
C  IP2       - (I) Input. The number of integration cycles to hold 
C                  the obsticle. 
C  DER       - (R) Input. The current time step size.
C  NFUNCT    - (I) Input. The current function number being evaluated.
C                  (Max value = 25 )
C  XVALUE    - (R) Output. The obstical height returned by this function.
C
C--Local Variable Definitions-------------------------------------------
C
C  TENDOBS(25)   - (R) Time at the end of the obstical width. 
C  SETHEIGHT(25) - (L) FLAG- an obstical is reached;  the obstical height
C                  AND time width need to be set.  
C
C-------------------------------------------------------------------------
C
      DIMENSION TENDOBS( 25 ), OBSHEIGHT( 25 )
      LOGICAL   SETHEIGHT( 25 )
C
      DATA ( TENDOBS(I), I=1,25) / 25 * 0.0 /, 
     1     ( OBSHEIGHT(II), II=1,25)/ 25 * 0.0 /,
     2     ( SETHEIGHT(J), J=1,25) / 25 * .TRUE. /
C
C
      IF( TIME .GE. CT0I ) THEN
C
C         The obstical has been reached.  Set the obstical height and 
C         hold the value for the given number of integration intervals.
C
          IF( SETHEIGHT( NFUNCT )  ) THEN 
C
C             First time interval - Set the height value 
C
              OBSHEIGHT( NFUNCT ) = RAYLEIGH( RMODE )  ! Height of the obstical
C
C             Set the obstical time width.  Add 1 percent of the step 
C             size to insure that the height is for the IP2 number of
C             steps and not IP2+1 due to roundoff and the way the 
C             computer stores the numbers. ( ie T = 7.9999998 and 
C             tendobs = 7.9999999 )
C
              TENDOBS( NFUNCT ) = TIME + ( IP2 * DER ) - ( 0.1 * DER )
C
C             Reset the flag:
C
              SETHEIGHT( NFUNCT )  = .FALSE.
C
          ELSEIF( TIME .GE. TENDOBS( NFUNCT )  ) THEN 
C
C             End of the obstical has been reached.  
C             End of step width reached.  Reset variables for next 
C             obstical.
C 
              OBSHEIGHT( NFUNCT )  = 0.0   ! Set obstical height to 0.0
C
C             Reset the CT0 to point to the next time an obstical 
C             occurs. TOBSTICAL = delta time until the next obstical;
C             T = current time.
C
              TOBSTICAL = EXPON( ALAMBDA )
              CT0I = TIME + TOBSTICAL
C
C             Set the flag so that the obstical height will be 
C             defined when the next obstical is reached.
C
              SETHEIGHT( NFUNCT )  = .TRUE.
          ENDIF
C
          XVALUE = OBSHEIGHT( NFUNCT ) 
C
      ELSE
C
C         The obstical has NOT yet been reached.  Set the obstical 
C         height to 0.0 and maintain this until the obstical is reached.
C
          XVALUE = 0.0
C
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE DATTIM
C
C-------------------------------------------------------------------------
C
C  This module inserts the current date and time into the job title at 
C  character locations TITLE(72:100)
C
C--Local Variable Definitions-------------------------------------------
C
C  DDATE - (C9) The current system date as returned from the DATE 
C          function.
C  DTIME - (C8) The current system time as returned from the TIME
C          function.
C
C-------------------------------------------------------------------------
C
      COMMON /HCOM/ TITLE
      CHARACTER*100 TITLE
      CHARACTER*100 TMPTITLE
C
C
      DIMENSION MONTHS (12)  
      CHARACTER MONTHS*3, CYR*4, DDATE*11      ! , DTIME*9
      INTEGER*2 IYR, IMON, IDAY
      character(8)  :: dt
      character(10) :: tm
      character(5)  :: zone
      DATA MONTHS / 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN',
     1              'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC' /
C
C---  Get the current system date and time.
C---      CALL GETDAT( IYR, IMON, IDAY )
      CALL DATE_AND_TIME( DATE=dt, ZONE=zone )

      WRITE(CYR,'(I4.4)') IYR
      WRITE(DDATE,100) IDAY, MONTHS(IMON), CYR
  100 FORMAT( I2.2, '-', A, '-', A )
C        
C
C---   Dr. Zipfel requested that the time not be included in title (12/1994)
C      CALL GETTIM(IHR, IMIN, ISEC, IHUND )
C      WRITE(DTIME,200) IHR, IMIN, ISEC 
C  200 FORMAT( I2.2, ':', I2.2, ':', I2.2 )      
C
C
C---   The following statements are used in the SVS version of CADAC.
C      DDATE = SSPDAT(1)
C      DTIME = SSPTIM()
C
C
C---  Insert the data and time into the job title at the end.
C     TITLE(1:100) = TITLE(1:70) // ' ' // DDATE // ' ' // DTIME 
      IF( LENSTR(TITLE) .LE. 70 ) THEN
        TMPTITLE = TITLE   
        TITLE = TMPTITLE(1:LENSTR(TMPTITLE)) // '  ' // DDATE 
      ELSE
        TITLE(1:100) = TITLE(1:70) // ' ' // DDATE    
      ENDIF
C
C
      RETURN
      END 
      FUNCTION DECAY( A, B, T )
C
C-------------------------------------------------------------------------
C
C
C--Argument Definitions-------------------------------------------------
C
C  A     - (R) Input.
C  B     - (R) Input.
C  T     - (R) Input.
C  DECAY - (R) Output.
C
C-------------------------------------------------------------------------
C
      DECAY = A * EXP( -ABS( B * T ) )
C
      RETURN
      END
      SUBROUTINE LD_DERIV( NUMSV )
C
C-------------------------------------------------------------------------
C  
C  This module loads the function initial data into the variable ( V ) and 
C  variable derivative ( DER ) arrays.  The data is loaded from the C
C  array, where the initial values are loaded by the input deck and 
C  modules.
C
C--Argument List Definition---------------------------------------------
C
C  NUMSV - (I) Input.  The number of state variables.  This was made a 
C          passed variable due because different code locations used a 
C          different variable in this position. 
C   
C-------------------------------------------------------------------------
C  
C
      COMMON          C(3510)
C 
      DIMENSION  DER(101), IPL(100), V(101), IPLV(100)
C
      EQUIVALENCE (C(2000), TIME    )
      EQUIVALENCE (C(2562), IPL(1)  )
      EQUIVALENCE (C(2664), DER(1)  )
      EQUIVALENCE (C(2765), V(1)    )
      EQUIVALENCE (C(2867), IPLV(1) )
C
C
      DO I = 2, NUMSV
C
C        Get the pointer into the C array for the state variable 
C        derivative.
C
         NODERIV  = IPL( I - 1 ) 
C
C        Get the pointer into the C array for the stage variable.
C
         IF( IPLV( I-1 ) .LT. 1 ) THEN
             NOSTATE = NODERIV + 3 
         ELSE
             NOSTATE = IPLV( I-1 )
         ENDIF
C
C        Load the variable array with the initial value.
C
         V( I ) = C( NOSTATE )
C
C        Load the derivative array with the derivative initial value.
C
         DER( I ) = C( NODERIV )
      ENDDO
C
C     The first integration variable is always time.  Initialize this
C     variable.
C
      V(1) = TIME
C
C
      RETURN
      END
      SUBROUTINE LD_CARRAY( NUMSV )
C
C-------------------------------------------------------------------------
C  
C  This module loads the C Array from the variable ( V ) and 
C  variable derivative ( DER ) arrays.  The data is loaded from the 
C  arrays used in the integration technique.  
C
C--Argument List Definition---------------------------------------------
C
C  NUMSV - (I) Input.  The number of state variables.  This was made a 
C          passed variable due because different code locations used a 
C          different variable in this position. 
C   
C-------------------------------------------------------------------------
C  
C
      COMMON          C(3510)
C 
      DIMENSION   DER(101), IPL(100), V(101), IPLV(100)
C
      EQUIVALENCE (C(2000), TIME    )
      EQUIVALENCE (C(2562), IPL(1)  )
      EQUIVALENCE (C(2664), DER(1)  )
      EQUIVALENCE (C(2765), V(1)    )
      EQUIVALENCE (C(2867), IPLV(1) )
C
C
      DO I = 2, NUMSV
C
C        Get the pointer into the C array for the state variable 
C        derivative.
C
         NODERIV  = IPL( I - 1 ) 
C
C        Get the pointer into the C array for the stage variable.
C
         IF( IPLV( I-1 ) .LT. 1 ) THEN
             NOSTATE = NODERIV + 3 
         ELSE
             NOSTATE = IPLV( I-1 )
         ENDIF
C
C        Load the stage variable values generated by the integration 
C        modules into the C array.
C
         C( NOSTATE ) = V( I )
      ENDDO
C
C
C     Load Time from the first variable.  Time is always 1.
C
      TIME = V(1)
C
C
      RETURN
      END

!--------------------------------------------------------------------
!
      FUNCTION EXPON( RMEAN )
!
!--------------------------------------------------------------------
!
!    This function generates a random variable that is exponentially 
!    distributed random with a mean of RMEAN.
!
!--------------------------------------------------------------------
!
!     RMEAN -  the mean of the exponential distribution; input by the
!              user.
!
!     EXPDEV - function to generate a random variable with an 
!              exponential distribution with a mean and variance
!              of (1,1) using a uniform random function with a mean 
!              of (0,1).
!
!     EXPON  - a random variable having a exponential distribution
!              with a mean and variance of (RMEAN,RMEAN**2).
!
!--------------------------------------------------------------------
!
      EXPON = EXPDEV() * RMEAN
!
      RETURN
      END
!
!--------------------------------------------------------------------
!
      FUNCTION EXPDEV()
!
!--------------------------------------------------------------------
!
!     EXPDEV - function to generate a random variable with an 
!              exponential distribution with a mean and variance
!              of (1,1) using a uniform random function with a mean 
!              of (0,1).
!
!            ( returns an exponentially distributed, positive, 
!              random deviate of unit mean using RANF() as the 
!              source of uniform deviates )
!
!
!--------------------------------------------------------------------
!
      EXPDEV = - ALOG ( RANF() )
!
      RETURN
      END
C
C-------------------------------------------------------------------------
C
      FUNCTION GAUSS( SIG, XMEAN )
C
C-------------------------------------------------------------------------
C
C    This function performs the gaussian distribution to a variable.
C
C-------------------------------------------------------------------------
C
C    Arguments:
C
C       SIG   -
C       XMEAN -
C
C    Local variables:
C
C       REAL:
C
C         TERM -
C         V1   -
C         V2   -
C         V1V2 -
C         X    -
C
C       LOGICALS:
C
C          DONE - indicates that  
C          SW   -
C
C-------------------------------------------------------------------------
C
      COMMON /FLAG1/ INITGAUSS 
      LOGICAL        INITGAUSS
C
C
      LOGICAL DONE
C
C
C    The SW flag was changed to an INITGAUSS assignment and added in 1992 
C    during the modifications to 
C    allow individual trajectories from a multirun case to be duplicated 
C    in a single run.  The GAUSS function provided a problem as the SW 
C    was initialized in a data statement to false; When only used once in a 
C    trajectory, the trajectories became "paired" with the Nth trajectory 
C    using V1 deviate and the N+1th trajectory using V2. This made 
C    duplication of the N+1th traj. impossible without running the Nth traj.  
C    Therefor the switch is set to false at the beginning of each trajectory, 
C    forcing the calculation of a new set of deviates for the given seed.
C    This should not pose a stat problem since an even number of GAUSS calls 
C    within a single trajectory will always use a particular deviate for 
C    calculating that variable, which produces the same situation.
C
C
      IF( INITGAUSS ) THEN
          X = V2*TERM
C
      ELSE
C
C        Find a pair of random deviates
C
         DONE = .FALSE.
         DO WHILE ( .NOT. DONE )
            V1 = 2. * RANF() - 1.0
            V2 = 2. * RANF() - 1.0
            V1V2 = V1 * V1 + V2 * V2
            IF( V1V2 .LT. 1. ) DONE = .TRUE.
         END DO 
C
         TERM = SQRT( -2. * ALOG( V1V2 ) / V1V2 )
C
         X = V1 * TERM
      ENDIF
C
C     Calculate the reqired random value.
C
      GAUSS = X * SIG + XMEAN
C
C     Change the switch value.
C
      INITGAUSS = .NOT. INITGAUSS
C
C
      RETURN
      END
      SUBROUTINE INI1_VARS
C
C-------------------------------------------------------------------------
C  
C  This module initializes several C variables that contain earth 
C  constants and conversion factors.  This initialization procedure is 
C  executed at the begining of each group (?) of runs.
C
C-------------------------------------------------------------------------
C
      COMMON        C(3510)
C
      EQUIVALENCE (C(0051), REARTH)
      EQUIVALENCE (C(0052), CRAD  )
      EQUIVALENCE (C(0054), AGRAV )
      EQUIVALENCE (C(0055), CFTM  )
      EQUIVALENCE (C(0056), CKFPS )
      EQUIVALENCE (C(0057), AMU   )
      EQUIVALENCE (C(0058), WEII3 )
C
C                        
C---  Conversion factor,  CRAD: multiply times radians to obtain degrees.
C
      CRAD = 57.29577951
C
C---  Conversion factor,  CFTM: multiply times feet to obtain meters.
C
      CFTM   = .3048006
C
C---  Conversion factor, CKFPS: multiply times knots to obtain ft/sec.
C
      CKFPS  = 1.6878
C
C---  Radius of the Earth (ft)
C
      REARTH = 20902190.
C
C--- Gravitational parameter mu for the Earth (ft^3/sec^2)
C
      AMU    = 1.407645E+16
C
C--- Acceleration due to gravity (ft/sec^2)
C
      AGRAV  = 32.174
C
C
C---  WEII3 = omega = angular rotation of the earth (rad/sec)
C     This variable is initialized to the rotating earth model 
C     (OPNORO=0).  If a NON rotating earth is desired, the OPNORO flag 
C     should be set to 1.0 with a type 3 card.
C
      WEII3 = 7.2921154E-05
C
C
      RETURN
      END
      SUBROUTINE INI1_PMIN 
C
C-------------------------------------------------------------------------
C
C  This module initializes the PMIN array to values appropriate for 
C  detecting the minimum values of the plot variables. 
C
C  NOTE:  Pmin = array containing the Minimum value of the plot 
C                variable. 
C
C--Argument List Definitions-------------------------------------------
C
C--Local Variable Definition--------------------------------------------
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      DIMENSION   PMIN(70)
C
      EQUIVALENCE (C(2127), PMIN(1)   )
C
C
C     Initialize the Minimum array to a very large number.
C
      DO I = 2, 70
         PMIN(I) = .99999E37
      END DO
C              
C     NOTE:  the first plot variable is always time.  This is forced by
C     the program and independant of the input.  However, set the first 
C     variable to -1.0 since this array is used to form the divider record
C     and the divider record has a -1.0 as the first number. 
C
      PMIN(1) = -1.0
C
C
      RETURN
      END
      SUBROUTINE OINPT1
C
C-------------------------------------------------------------------------
C
C   This module processes the input card data.  The input card data is
C   read by module LARGE.  This module moves the data into the working 
C   arrays and processes the information.
C
C--Local Variable Definition--------------------------------------------
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /KRUN/  JRUN, MULRUN, IGROUP
C
      COMMON /STAGE1/  ISTAGE, NUMSTAGE
C
      EQUIVALENCE (C(2361), NOMOD   )
      EQUIVALENCE (C(2461), NOSUB   )
C
      DATA ISWTH / 0 /
C
C
C
  100 CONTINUE
C
C
C     Initialize some variables.
C
      CALL OIN1_INIT
C
C
C     Load the cards and process them
C
      CALL OIN1_PROCESS( ISWTH )
C
C
C     Check the print intervals and determine is it needs to be 
C     adjusted.
C
      CALL OIN1_PRTCHK
C
C
C     Check to see if some "modules" have been selected for execution.
C
      IF( NOMOD .LE. 0 ) THEN
          ISWTH = 101
          WRITE(ID_TABOUT,1920)
 1920     FORMAT( '0------ ERROR. AT LEAST ONE MODULE MUST BE CALLED.',
     1            '     RUN ABORTED. ------' )
      ENDIF
C
C
C---  Check to see if some "MODULES" have been selected for execution.
      IF(  NOSUB .LE. 0 ) THEN
          ISWTH = 101
          WRITE(ID_TABOUT,1940)
 1940     FORMAT( '0------ ERROR. AT LEAST ONE SUBROUTINE MUST BE ' 
     1            'CALLED.     RUN ABORTED. ------')
      ENDIF
C
C
C---  This is the original error check.  This was modified under T9108
C---  If an error occurs and the end of the primary trajectory
C---  has not been reached, then continue reading the cards.
C---  IF( ISWTH .NE. 0  .AND.  ISTAGE .NE. 6 ) GOTO 100
C---  Otherwise - no error and reached a 16/12 card, or the end of the 
C---  primary trajectory data cards - Calculate the trajectory.
C
      IF( ISWTH .NE. 0 ) THEN 
C 
C         An error occurred during the input.  
C
          IF( IGROUP .LT. 2 ) THEN 
C
C---           The input error occurred while reading the primary 
C---           trajectory.  Stop the program so that the user can fix 
C---           the error.
               WRITE(ID_TABOUT,*)
     1          ' ERROR ON INPUT - PROGRAM STOPPED. ERROR=', ISWTH
               WRITE(ID_TABOUT,*) ' '
               WRITE(ID_TABOUT,*)
     1         ' ERROR ON INPUT - PROGRAM STOPPED. ERROR=',  ISWTH
               WRITE(ID_TABOUT,*) ' '
               STOP ' '
          ENDIF
C 
C---      Otherwise the primary trajectory was read with no errors - the 
C---      errors were in the stage cards.  Print a message but continue 
C---      reading and processing.  The previous stages may have been 
C---      correct and following stages may be correct.  This was done to 
C---      prevent unnecessary interruption of long running jobs.
          WRITE(ID_TABOUT,*)
     1    ' ERROR ON STAGE INPUT - CONTINUING PROCESSING...'
C     
          WRITE(ID_TABOUT,*) ' '  
C          
          WRITE(ID_TABOUT,*)
     1    ' ERROR ON STAGE INPUT - CONTINUING PROCESSING...'
C     
          WRITE(ID_TABOUT,*) ' '
C
          GOTO 100
C
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE OIN1_EMSG( ICARDTYPE )
C
C-------------------------------------------------------------------------
C
C  Displays the error message for invalid input on the cards.
C
C--Argument List Definitions--------------------------------------------
C
C  ICARDTYPE - (I) Input.  The card type currently beingprocesIR(1) )
C
C-------------------------------------------------------------------------
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /OINDAT/  J16, ICD, I16
C
C
      WRITE(ID_TABOUT,880) ICARDTYPE, ICD, J16
  880 FORMAT( ' -INPUT ERROR, RUN ABORTED. IR(1)-ICD-J16 ', 3I4 )
C
C
      RETURN 
      END 
      SUBROUTINE OIN1_INIT
C
C-------------------------------------------------------------------------
C
C  This module performs some variable initialization necessary at each 
C  call to OINPT1
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      COMMON /COLLER/ HOL(5)
      CHARACTER       HOL*80
C
      COMMON /KRUN/  JRUN, MULRUN, IGROUP
C
      COMMON /STAGE/   LOC(2), INCRS(2), VAL(2), UNITS(2), KODE(2), 
     1                 TEST(2), LOCT(2), NTEST
C
C
C
C---  Clear the Hollerith (card type 9) data so that if more is read
C     during the next stage, the new data will be displayed.  
C
      DO I = 1, 5
         HOL(I) = ' '
      ENDDO
C
C     Initialize the Number of stage tests to 0.  Ntest will be set
C     by the C10_process module if a stage card is encountered at the
C     end of this stage.  If a card type 12 or 6 is encountered at
C     the end of this stage, then the test number will be properly
C     set and the stage module will skip the stage testing, thereby
C     executing the trajectory to the end.
C
      NTEST = 0
C
C
      RETURN
      END
      SUBROUTINE OIN1_LOAD( IR, MODE, VR, ALPHA, MINT )
C
C-------------------------------------------------------------------------
C
C This module transfers the card data from the working trajectory arrays 
C into working variables.
C
C--Argument List Definitions--------------------------------------------
C
C  ALPHA(3) - (C6) Contains the character data from the input card 
C             currently being processed. (1= cols 3:8, 2= cols 9:14, 
C             3= 15:20 )
C  IR(2)    - (I) Contains the integer data from the input card that is 
C             currently being processed. (1= cols 1:2;  2= cols 21:25 )
C  MODE     - (I) Contains an integer from the input card that is 
C             currently being processed. (cols 26:30 )
C  VR(2)    - (R) Contains the real data from the input card that is 
C             currently being processed. (1= cols 31:45, 2= cols 46:60 )
C  MINT     - (I) Contains the last integer data form the input card.
C
C--Local Variable Definition--------------------------------------------
C
C-------------------------------------------------------------------------
C
      DIMENSION IR(2), VR(2)
      CHARACTER ALPHA(3)*6
C
C
      COMMON /OINDAT/  J16, ICD, I16
C
      COMMON /STAGE1/  ISTAGE, NUMSTAGE
C
      COMMON /WSET/    NCARD, JTYPE(500), LOCA(500), MOE(500), 
     1                 VA1(500), VA2(500), M2(500)
C
      COMMON /WSETC/   AL(3,500), HOLL(5)
      CHARACTER        AL*6, HOLL*80
C
      COMMON /WSETST/  NCDW(20), JTST(20,60), LOCST(20,60), 
     1                 MODST(20,60), VA1ST(20,60), VA2ST(20,60),
     2                 M2ST(20,60)
C
      COMMON /WSETSTC/ ALST(20,3,60)
      CHARACTER        ALST*6
C
C
C
C
  100 CONTINUE
C
C
      IF( J16 .GT. 0 ) THEN 
C
C         J16=1: Processing stage cards.  Load the data from the stage 
C                arrays.  
C
          IF( I16 .LE. 0   .AND.  NCDW(NUMSTAGE) .LT. 1 ) THEN 
C
C             No stage cards for this stage - Reset to read cards from 
C             the main trajectory arrays.
C
              J16 = 0
              GOTO 100
C
          ELSE
C
C             Increment stage card counter:
C
              I16 = I16 + 1
C
              IF( I16 .LE. NCDW( NUMSTAGE )  ) THEN 
C
C                 Not reached the end of the stage cards yet.  Load the
C                 data from the stage input data arrays.
C
                  IR(1) = JTST(  NUMSTAGE, I16)
                  IR(2) = LOCST( NUMSTAGE, I16)
C
                  DO IZ = 1, 3
                     ALPHA(IZ) = ALST(NUMSTAGE,IZ, I16)
                  END DO
C
                  MODE  = MODST(NUMSTAGE, I16)
                  MINT  = M2ST( NUMSTAGE, I16)
                  VR(1) = VA1ST(NUMSTAGE, I16)
                  VR(2) = VA2ST(NUMSTAGE, I16)
C
              ELSE
C
C                 Reached the last card in the stage.  Reset the J16 
C                 flag and read the data from the main trajectory arrays.
C
                  J16 = 0
                  GOTO 100
C
              ENDIF
C
          ENDIF
C
C
      ELSE
C
C         J16= 0: - load data from the main trajectory arrays. 
C
C         Increment the card counter for the main trajectory arrays.
C
          ICD = ICD + 1
C
C         Transfer the data to the working arrays.
C
          IR(1) = JTYPE(ICD)
          IR(2) = LOCA(ICD)
C
          DO IZ = 1, 3
             ALPHA(IZ) = AL(IZ,ICD)
          END DO
C
          MODE  = MOE(ICD)
          MINT  = M2( ICD)
          VR(1) = VA1(ICD)       
          VR(2) = VA2(ICD)
C
      ENDIF
C
C
C     Go process card data.
C
C
      RETURN
      END
      SUBROUTINE OIN1_PROCESS( ISWTH )
C
C-------------------------------------------------------------------------
C
C  This module loads the card data from the working arrays, and calls the 
C  processing modules
C
C--Local Variable Definition--------------------------------------------
C
C  ALPHA(3) - (C6) Contains the character data from the input card 
C             currently being processed. (1= cols 3:8, 2= cols 9:14, 
C             3= 15:20 )
C  IR(2)    - (I) Contains the integer data from the input card that is 
C             currently being processed. (1= cols 1:2;  2= cols 21:25 )
C  MODE     - (I) Contains an integer from the input card that is 
C             currently being processed. (cols 26:30 )
C  VR(2)    - (R) Contains the real data from the input card that is 
C             currently being processed. (1= cols 31:45, 2= cols 46:60 )
C
C-------------------------------------------------------------------------
C
      DIMENSION IR(2), VR(2)
      CHARACTER ALPHA(3)*6
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /KRUN/    JRUN, MULRUN, IGROUP
C
      COMMON /OINDAT/  J16, ICD, I16
C
      COMMON /STAGE1/  ISTAGE, NUMSTAGE
C
  140 CONTINUE
C
C
C     Load the card data from the arrays into working variables.
C
      CALL OIN1_LOAD( IR, MODE, VR, ALPHA, MINT )
C
C
C     Start card processing:
C
      IF( IR(1) .GT. 89 ) THEN 
C
C---      Card type 90 or 91: Mod to save and restore simulation state.
C                                    
          CALL C90_PROCESS
C
C
      ELSEIF( IR(1) .EQ. 1 ) THEN 
C
C         Card type 1: Module selection cards of modules to be executed 
C             After Each Integration Step.
C
          CALL C1_PROCESS( IR(2), ISWTH )
C
C
      ELSEIF( IR(1) .EQ. 2 ) THEN 
C
C         Card type 2:  Module selection cards.  These cards contain the 
C         list of module numbers to be executed, in the order of execution.  
C
          CALL C2_PROCESS( IR(2), ISWTH )
C
C
      ELSEIF( IR(1) .EQ. 3 ) THEN
C
C         Card type 3 : Variable initialization Cards.  
C
          CALL C3_PROCESS( IR(2), VR, MODE, ALPHA(3), ISWTH )
C
C
      ELSEIF( IR(1) .EQ. 4 ) THEN 
C
          CONTINUE
C
C
      ELSEIF( IR(1) .EQ. 5 ) THEN
C
C         Card type 5 : Number of trajectories to run.
C     
          IF( MODE .LT. JRUN ) THEN
            WRITE(ID_TABOUT,*) ' ERROR ON TYPE 5 CARD '
            WRITE(ID_TABOUT,*) ' Num of runs entered is invalid: ', MODE
            ISWTH = 101
            RETURN                    
          ENDIF
C
          MULRUN = MODE
C
C
      ELSEIF( IR(1) .EQ. 6 ) THEN 
C
C         Card type 6 : end of primary trajectory.
C
C         Store stageing flag to remember why staged. 
C
          ISTAGE = IR(1)
C
C         Go finish executing the trajectory.
C
          RETURN
C
C
      ELSEIF( IR(1) .EQ. 7 ) THEN 
C
          CALL C7_PROCESS( IR(2), MODE, VR, NUMSTAGE, ISWTH )
C
C
      ELSEIF( IR(1) .EQ. 8 ) THEN 
C
C         Card type 8 : Read and set up weather data.
C         Display the data to the output file also. 
C
          CALL C8_PROCESS
C
C
      ELSEIF( IR(1) .EQ. 9 ) THEN
C
C         Card type 9 : Text information
C
          CALL C9_PROCESS( IR(2) )
C
C
      ELSEIF( IR(1) .EQ. 10 ) THEN
C
C         Card type 10: Conditions for staging
C
          CALL C10_PROCESS( IR(2), ISWTH )
C
C
      ELSEIF( IR(1) .EQ. 11 ) THEN
C
C         Card type 11 - 
C
          CALL C11_PROCESS( IR(2), ALPHA, VR, ISWTH, MODE )
C
C
      ELSEIF( IR(1) .EQ. 16 ) THEN
C
C---      End of stage criteria = start of a stage.  Continue the 
C         trajectory until the stage criteria has been met then process 
C         the cards from the stage arrays for this stage.
C
          J16 = 1    ! Set flag for loading from stage arrays.
          I16 = 0    ! Initialize stage card counter.
C
C         Store stageing flag to remember why staged.
C
          ISTAGE = IR(1) 
C
C         Go process the trajectory until the stage criteria is met.
C
          RETURN
C
C
      ELSEIF( IR(1) .EQ. 19 ) THEN 
C
          CALL C19_PROCESS( IR(2), MODE, VR, MINT, ISWTH )
C
C
      ELSEIF( IR(1) .EQ. 20 ) THEN 
C
          CALL C20_PROCESS( IR(2), MODE, VR, ISWTH )
C
C
      ELSEIF( IR(1) .EQ. 21 ) THEN 
C
          CALL  C21_PROCESS( IR(2), MODE, VR, MINT, ISWTH )
C
C
      ELSE
C
C         Invalid card type entered.  Write the error message.
C
          ISWTH = 101
          CALL OIN1_EMSG( IR(1) ) 
          STOP ' '
C
C
      ENDIF
C
C
C     Go process the next card.
C
      GOTO 140
C
C
      RETURN
      END
      SUBROUTINE OIN1_PRTCHK
C
C-------------------------------------------------------------------------
C
C  This module checks to see if the print/plot time intervals need to be 
C  saved or adjusted after a batch of input cards have been processed.
C  If the trajectory is just being started, then the print interval save
C  variables need to be initialized.  If the trajectory has been 
C  started, then check to see if the print intervals have been modified;  
C  if so, then modify the next print time accordingly.
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      COMMON /PREV/    TPREV, CPPREV, PPPREV
C
C
      EQUIVALENCE (C(2000), TIME )
      EQUIVALENCE (C(2003), PCNT )
      EQUIVALENCE (C(2004), PPNT )
      EQUIVALENCE (C(2005), PPP  )
      EQUIVALENCE (C(2015), CPP  ) 
C
C
C
      IF( TIME .LE. 0.0 ) THEN 
C
C         The trajectory has not started yet.  Save the tabular print 
C         rate.
C
          CPPREV = CPP
          PPPREV = PPP
C
      ELSE
C
C         Integration has already begun.  
C   
          IF( CPP .NE. CPPREV ) THEN 
C 
C             The current print rate is not the same as the previous 
C             print rate;  the user has modified the print rate.
C
C             Estimate the next tabular print time by subtracting the  
C             previous print interval then adding the new print 
C             interval.
C
              PCNT = PCNT - CPPREV + CPP
C
C             Insure that the next print time is greater than the 
C             current time.
C
              DO WHILE ( PCNT .LT. TIME  ) 
C
C                 Increase the next print time
C
                  PCNT = PCNT + CPP
              ENDDO
C
C             Save the new print time interval
C
              CPPREV = CPP
C
          ENDIF
C
C
          IF( PPP .NE. PPPREV ) THEN 
C
C             The plot interval has been modified.
C             Estimate the next plot print time by subtracting the  
C             previous print interval then adding the new print 
C             interval.
C
              PPNT = PPNT - PPPREV + PPP
C
C             Insure that the next print time is greater than the 
C             current time.
C
              IF( PPNT .LT. TIME ) THEN 
C
C                 Increase the next print time
C
                  PPNT = PPNT + PPP
              ENDIF
C
C             Save the new print time interval
C
              PPPREV = PPP
C
          ENDIF
C
      ENDIF
C
      RETURN
      END
C
C-------------------------------------------------------------------------
C
      SUBROUTINE OP_START( NPLOTVAR )
C
C-------------------------------------------------------------------------
C  
C  This module writes the title and first header records to the output 
C  file/display (unit 6)
C
C--Argument List Definitions-------------------------------------------
C
C NPLOTVAR - (I) Integer containing the number of variables input 
C            selected for plotting on the HEADER file.
C
C-------------------------------------------------------------------------
C  
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /HCOM/   TITLE
      CHARACTER       TITLE*100 
C
      COMMON /OPFLAG/ INTMSG, STGMSGOUT, INECHO, XSWEEP
      LOGICAL         INTMSG, STGMSGOUT, INECHO, XSWEEP
C
      COMMON /OPSVAR/ ISCROL, KLOC(16), LPRT, IHEADP, INTS(16)
      LOGICAL         INTS
C
      COMMON /OPFLGC/ FMTSTRING, TRACE
      CHARACTER       FMTSTRING*85, TRACE(16)*8            
C
      COMMON /FIRSTI/ FINIT
      LOGICAL FINIT
C
      INTEGER   GETENVQQ
      CHARACTER FILENAME*50
C
C
C---  Open the file containing the input cards (35) CADIN.ASC
C
C------------------------Vax Code-------------------------------------
C
C     Check the filename then open the file:
C     Translate the logical name.  If the logical name is undefined, the 
C     FILENAME variable is loaded with the name of the logical.
C
C      CALL LIB$SYS_TRNLOG( 'INDATA', LENGTH, FILENAME )
C
C      IF( FILENAME(1:LENGTH) .EQ. 'INDATA' ) THEN
C 
C         A filename was not defined in the logical name:
C         Set the filename to the default:
C
C          FILENAME = 'FOR005.DAT'
C      ENDIF
C
C------------------------PC Code-------------------------------------
C
C---  Check to see if the filename for the input file CADIN.ASC 
C---  was set using an enviroment variable.  If so, translate the 
C---  environment variable. If the variable is undefined (the value of
C---  LENGTH is 0) set the file name to the default. 
C---      LENGTH = get_environment_variable( 'CADIN', FILENAME )
      LENGTH = 0
      IF( LENGTH .EQ. 0 ) FILENAME = 'CADIN.ASC' 
C
C---  Open the CADIN.ASC file.      
C---      OPEN(UNIT=ID_CADIN, FILE = FILENAME(1:LENSTR(FILENAME)),
C---     1     STATUS='OLD', MODE='READ', ERR =999)
C---      OPEN(UNIT=ID_CADIN, FILE = 'CADIN.ASC' )
      OPEN(UNIT=ID_CADIN, FILE = FILENAME(1:LENSTR(FILENAME)) )

C
C
C      
C---  Open the tabular output file (6)         
C 
      ID_TABOUT = 6
      IF( TABOUT ) THEN 
C
C---    Inform the user that the tabular output is being written to the
C---    file TABOUT.ASC.
        WRITE( *,'(//A)' )
     1  '* * * Tabular output is being written to file TABOUT.ASC * * *' 
C     
C---    Check to see if the filename for the input file TABOUT.ASC 
C---    was set using an enviroment variable.  If so, translate the 
C---    environment variable. If the variable is undefined (the value of
C---    LENGTH is 0) set the file name to the default. 
C---        LENGTH = GETENVQQ( 'TABOUT', FILENAME )
        LENGTH = 0      
        IF( LENGTH .EQ. 0 ) FILENAME = 'TABOUT.ASC'
C
        OPEN( UNIT=ID_TABOUT, FILE=FILENAME(1:LENSTR(FILENAME)),
     1        STATUS='UNKNOWN' )
C
      ENDIF                    
C
C-------------------------------------------------------------------- 
C
C---  Write the initial output to the tabular output file (6)
C---  Put a copy of the input cards to the output file/display
      IF( INECHO ) CALL SAV_INSTREAM
C
C---  Add the current date and time to the title variable (cols 72-100)
C
C---  Read the title variable:
      REWIND ( ID_CADIN )
      READ(ID_CADIN, '(A)' ) TITLE
      REWIND ( ID_CADIN )
C
C     
C---  Get the date and the time.
      CALL DATTIM         
C
C
C---  Display the title to the output device. 
      WRITE(ID_TABOUT, '(1X,A)' ) TITLE        
C      
C---  Write execution title to the screen if the output is going to a file.
      IF( TABOUT ) WRITE(*, '(// 1X,A)' ) TITLE
C

C---  Display the scroll variable acronyms : ie header for output data.
C---  In order to avoid a blank line after the acronyms when 10 scroll
C---  variables are selected, the last variable is written without 
C---  following blanks.
      IF( LPRT .EQ. 10 )  THEN 
        WRITE(ID_TABOUT, '( 1X, 9A8, A )' )  
     1  ( TRACE(II),II=1,LPRT-1 ), TRACE(LPRT)(1:LENSTR(TRACE(LPRT))) 
      ELSEIF( LPRT .GT. 0 ) THEN 
        WRITE(ID_TABOUT, '( 1X, 16A8 )' ) 
     1  ( TRACE(II),II=1,LPRT )
      ENDIF
C
C
C---  Open the binary and ascii trajectory files files and write the 
C---  header records if the files are to be created.
C
C---  Check to see if the binary trajectory file is to be created.
      IF( TRAJBIN ) THEN 
C
C---    Check to see if the filename for the binary trajectory file 
C---    was set using an enviroment variable.  If so, translate the 
C---    environment variable. If the variable is undefined (the value of
C---    LENGTH is 0) set the file name to the default. 
C---        LENGTH = GETENVQQ( 'TRAJBIN', FILENAME )
        LENGTH = 0
        IF( LENGTH .EQ. 0 ) FILENAME = 'TRAJ.BIN'
C
C---    Open the binary trajectory file.        
C---        OPEN( UNIT=ID_TRAJBIN, FILE = FILENAME(1:LENSTR(FILENAME)),
C---     1        STATUS='UNKNOWN', FORM='BINARY' ) 
C---        OPEN( UNIT=ID_TRAJBIN, FILE = 'TRAJ.BIN' )
        PRINT *, 'FILENAME:', FILENAME(1:LENSTR(FILENAME)) 
        OPEN( UNIT=ID_TRAJBIN, FILE = FILENAME(1:LENSTR(FILENAME)) )

        
      ENDIF
C
C
C---  Check to see if the ascii trajectory file is to be created.
      IF( TRAJASC ) THEN
CcccccGAB the TRAJ.ASC file does not have the proper format for plotting..
C---    Check to see if the filename for the ascii trajectory file 
C---    was set using an enviroment variable.  If so, translate the 
C---    environment variable. If the variable is undefined (the value of
C---    LENGTH is 0) set the file name to the default. 
C---        LENGTH = GETENVQQ( 'TRAJASC', FILENAME )
        LENGTH = 0
        IF( LENGTH .EQ. 0 ) FILENAME = 'TRAJ.ASC'
C        
C---    Open the binary statistics file.        
C---        OPEN( UNIT=ID_TRAJASC, FILE = FILENAME(1:LENSTR(FILENAME)),
C---      1        STATUS='UNKNOWN', FORM='FORMATTED' ) 
C---            OPEN( UNIT=ID_TRAJASC, FILE = 'TRAJ.ASC' ) 
            PRINT *, 'FILENAME:', FILENAME(1:LENSTR(FILENAME)) 
            OPEN( UNIT=ID_TRAJASC, FILE = FILENAME(1:LENSTR(FILENAME)) ) 
C
      ENDIF     
C
C
C---  Open the binary and ascii statistics files files and write the 
C---  header records if the files are to be created.
C------------------------PC Code-------------------------------------
C
C
C---  Check to see if the binary statistics file is to be created.
      IF( STATBIN ) THEN 
C
C---    Check to see if the filename for the binary statistists file 
C---    was set using an enviroment variable.  If so, translate the 
C---    environment variable. If the variable is undefined (the value of
C---    LENGTH is 0) set the file name to the default. 
C---        LENGTH = GETENVQQ( 'STATBIN', FILENAME )
        LENGTH = 0
        IF( LENGTH .EQ. 0 ) FILENAME = 'STAT.BIN'
C
C---    Open the binary statistics file.        
C---        OPEN( UNIT=ID_STATBIN, FILE = FILENAME(1:LENSTR(FILENAME)),
C---     1        STATUS='UNKNOWN', FORM='BINARY' ) 
C---        OPEN( UNIT=ID_STATBIN, FILE = 'STAT.BIN' )
        PRINT *, 'FILENAME:', FILENAME(1:LENSTR(FILENAME)) 
        OPEN( UNIT=ID_STATBIN, FILE = FILENAME(1:LENSTR(FILENAME)) )
      ENDIF
C
C
C---  Check to see if the ascii statistics file is to be created.
      IF( STATASC ) THEN
C
C---    Check to see if the filename for the ascii statistists file 
C---    was set using an enviroment variable.  If so, translate the 
C---    environment variable. If the variable is undefined (the value of
C---    LENGTH is 0) set the file name to the default. 
C---        LENGTH = GETENVQQ( 'STATASC', FILENAME )
        LENGTH = 0
        IF( LENGTH .EQ. 0 ) FILENAME = 'STAT.ASC'
C        
C---    Open the binary statistics file.        
        PRINT *, 'FILENAME:', FILENAME(1:LENSTR(FILENAME)) 
        OPEN( UNIT=ID_STATASC, FILE = FILENAME(1:LENSTR(FILENAME)),
     1      STATUS='UNKNOWN', FORM='FORMATTED' ) 
C
      ENDIF     
C
C--- Check to see if RT CADAC files are to be created
C    added under XR Task 97 - Real-Time CADAC
C
C---  Check to see if the binary initialization file is to be created.
      IF( INITBIN ) THEN 
C
C---    Check to see if the filename for the binary statistists file 
C---    was set using an enviroment variable.  If so, translate the 
C---    environment variable. If the variable is undefined (the value of
C---    LENGTH is 0) set the file name to the default. 
C---        LENGTH = GETENVQQ( 'INITBIN', FILENAME )
        LENGTH = 0
        IF( LENGTH .EQ. 0 ) FILENAME = 'INIT.BIN'
C
C---    Open the binary statistics file.        
C---        OPEN( UNIT=ID_INITBIN, FILE = FILENAME(1:LENSTR(FILENAME)),
C---     1        STATUS='UNKNOWN', FORM='BINARY' ) 
        PRINT *, 'FILENAME:', FILENAME(1:LENSTR(FILENAME)) 
        OPEN( UNIT=ID_INITBIN, FILE = FILENAME(1:LENSTR(FILENAME)) )

C---           &STATUS='UNKNOWN', FORM='FORMATTED' ) 
C
C---    Set the First INIT write flag to true
        FINIT = .TRUE.
C
      ENDIF
C
C
C---  Check to see if the ascii initialization file is to be created.
      IF( INITASC ) THEN
C
C---    Check to see if the filename for the ascii initialization file 
C---    was set using an enviroment variable.  If so, translate the 
C---    environment variable. If the variable is undefined (the value of
C---    LENGTH is 0) set the file name to the default. 
C---        LENGTH = GETENVQQ( 'INITASC', FILENAME )
        LENGTH = 0
        IF( LENGTH .EQ. 0 ) FILENAME = 'INIT.ASC'
C        
C---    Open the binary initialization file.        
C---        OPEN( UNIT=ID_INITASC, FILE = FILENAME(1:LENSTR(FILENAME)),
C---     1      STATUS='UNKNOWN', FORM='FORMATTED' ) 
        PRINT *, 'FILENAME:', FILENAME(1:LENSTR(FILENAME))
        OPEN( UNIT=ID_INITASC, FILE = FILENAME(1:LENSTR(FILENAME)) )

C
C---    Set the First INIT write flag to true
        FINIT = .TRUE.
C
      ENDIF     
C
C---  Check to see if the binary track data file is to be created.
      IF( TRACKBIN ) THEN 
C
C---    Check to see if the filename for the binary track data file 
C---    was set using an enviroment variable.  If so, translate the 
C---    environment variable. If the variable is undefined (the value of
C---    LENGTH is 0) set the file name to the default. 
C----        LENGTH = GETENVQQ( 'TRACKBIN', FILENAME )
        LENGTH = 0
        IF( LENGTH .EQ. 0 ) FILENAME = 'TRACK.BIN'
C
C---    Open the binary track data file.        
C---        OPEN( UNIT=ID_TRACKBIN, FILE = FILENAME(1:LENSTR(FILENAME)),
C---     1        STATUS='UNKNOWN', FORM='BINARY' ) 
        PRINT *, 'FILENAME:', FILENAME(1:LENSTR(FILENAME))
        OPEN( UNIT=ID_TRACKBIN, FILE = FILENAME(1:LENSTR(FILENAME)) )
      ENDIF
C
C
C---  Check to see if the ascii track data file is to be created.
      IF( INITASC ) THEN
C
C---    Check to see if the filename for the ascii track data file 
C---    was set using an enviroment variable.  If so, translate the 
C---    environment variable. If the variable is undefined (the value of
C---    LENGTH is 0) set the file name to the default. 
C---        LENGTH = GETENVQQ( 'TRACKASC', FILENAME )
        LENGTH = 0
        IF( LENGTH .EQ. 0 ) FILENAME = 'TRACK.ASC'
C        
C---    Open the binary statistics file.        
        PRINT *, 'FILENAME:', FILENAME(1:LENSTR(FILENAME))
        OPEN( UNIT=ID_TRACKASC, FILE = FILENAME(1:LENSTR(FILENAME)),
     1      STATUS='UNKNOWN', FORM='FORMATTED' ) 
C
      ENDIF      
C
      CALL STRT_PLOT( NPLOTVAR )
C
C
C---  The output file of stocastic variable initial values (from 
C---  type 3 card) has been requested.   
C
      IF( RANVAR ) THEN
C       
C---    Check to see if the filename for the binary statistists file 
C---    was set using an enviroment variable.  If so, translate the 
C---    environment variable. If the variable is undefined (the value of
C---    LENGTH is 0) set the file name to the default. 
C---        LENGTH = GETENVQQ( 'RANVAR', FILENAME )
        LENGTH = 0
        IF( LENGTH .EQ. 0 ) FILENAME = 'RANVAR.ASC'

        PRINT *, 'FILENAME:', FILENAME(1:LENSTR(FILENAME))
        OPEN( UNIT=ID_RANVAR, FILE=FILENAME(1:LENSTR(FILENAME)),
     1        STATUS='UNKNOWN', FORM='FORMATTED' )
C
C---    Display the title to the output device.
        WRITE(ID_RANVAR, '(1X,A)' ) TITLE  
C        
      ENDIF
C
C
      RETURN
C
C
C---  Input file open error statement:
C
  999 CONTINUE
C
C
      WRITE(ID_TABOUT,*) 
      WRITE(ID_TABOUT,*)
     1' *** ERROR OPENING LEAD CARD DECK: ', FILENAME, '***'
      WRITE(ID_TABOUT,*) 
C
      STOP ' '
      END
      SUBROUTINE OUPT2
C
C-------------------------------------------------------------------------
C
C  This module is the initialization module for module OUPT3. ?
C
C-------------------------------------------------------------------------
C
      COMMON      C(3510)
C
      EQUIVALENCE (C(2016), PGCNT  )
      EQUIVALENCE (C(2014), ITCNT  )  
      EQUIVALENCE (C(2003), PCNT   ) 
      EQUIVALENCE (C(2000), TIME   )  
      EQUIVALENCE (C(2004), PPNT   )  
C
C
      ITCNT = 1
      PGCNT = 1
C
      PCNT  = TIME - 0.000001
      PPNT  = PCNT
C
C
      RETURN
      END
      SUBROUTINE OUPT3( STAGEMET )
C
C-------------------------------------------------------------------------
C
C  This module controls data output.  If the SCROLL option has been 
C  selected, this module prints the data to the appropriate output device, 
C  displaying the header records at appropriate intervals.  This module 
C  also controls the output to the plot files, printing the data 
C  at the appropriate moments in the simulation.
C
C--Argument List Definitions--------------------------------------------
C
C  STAGEMET - (L) .True. - a stage condition has been met prior to 
C             the module call.   .False. - called after modules to check 
C             print times.
C
C-------------------------------------------------------------------------
C
      LOGICAL   STAGEMET 
C
C---  Print the data to the tabular output file:
      CALL OP3_WR_TABOUT
C
C---  Write the TRAJ data:
      CALL OP3_11TEST
C
C---  Write the STAT data:
      CALL OP3_44PLOT( STAGEMET )
C
C
      RETURN
      END
      SUBROUTINE OP3_11TEST
C
C-------------------------------------------------------------------------
C
C  This module controls the writting to the TRAJ.*.  The data is 
C  written at the user specified intervals 
C
C-------------------------------------------------------------------------
C
      COMMON    C(3510)
C
      EQUIVALENCE (C(2000), TIME  )
      EQUIVALENCE (C(2005), PPP   ) 
      EQUIVALENCE (C(2004), PPNT  )
      EQUIVALENCE (C(2020), LCONV )
C
C
      IF( PPP .NE. 0.0 ) THEN 
C
C        The print interval is not 0.0, so test for printing to the plot 
C        file.
C
         IF( LCONV .GT. 1 ) THEN
C
C            End of trajectory calculations.  
C            Print the data to the plot files regardless of the print time.
C
             CALL OP3_11WRITE 
C
C            Print data RT file if necessary
C
         ELSEIF( TIME .GE. PPNT ) THEN 
C
C            Calculate the next plot print time.
C            Increment the plot print time.
C
             PPNT = PPNT + PPP
             PPNT = AMAX1( PPNT, TIME )
C
C            Print the to the plot files.
C
             CALL OP3_11WRITE
C
C
         ENDIF
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE OP3_11WRITE
C
C-------------------------------------------------------------------------
C
C  This module writes the selected plot variable data to the TRAJ.*.
C  The data is also tested to collect the minimum and maximum values.
C
C--Local Variable Definitions---------------------------------------------
C
C-------------------------------------------------------------------------
C
      DIMENSION PLOTDATA(70), IC(3510)
C
      COMMON    C(3510)
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /KRUN/    JRUN, MULRUN, IGROUP
C
      COMMON /OPPLOT/  IPLADD(70), INTPLOT(70)
      LOGICAL          INTPLOT
C
C
      EQUIVALENCE (C(0001), IC(0001) )
      EQUIVALENCE (C(2020), LCONV    )
      EQUIVALENCE (C(2280), NV       )
C
C      
C---  Load the min/max arrays
      CALL LD_MINMAX
C
C---  Insure that time is first.
      IPLADD(1) = 2000    
C
C---  Determine the data to print to the TRAJ.* files.
      DO I = 1, NV 
         IF( INTPLOT(I) ) THEN
             PLOTDATA(I) = IC( IPLADD(I) ) 
         ELSE
             PLOTDATA(I) = C( IPLADD(I) )
         ENDIF
      ENDDO
C   
      IF( TRAJBIN ) WRITE(ID_TRAJBIN)   ( PLOTDATA(I), I=1,NV )  
      IF( TRAJASC ) WRITE(ID_TRAJASC,*) ( PLOTDATA(I), I=1,NV )
C
C
      RETURN
      END
      SUBROUTINE OP3_44PLOT(  STAGEMET )
C
C-------------------------------------------------------------------------
C
C  This module controls the printing of the data to the STAT.* plot 
C  file.
C
C--Argument List Definitions--------------------------------------------
C
C  STAGEMET - (L) .True. - a stage condition has been met prior to 
C             the module call.   .False. - called after modules to check 
C             print times.
C
C-------------------------------------------------------------------------
C
      LOGICAL STAGEMET
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /KRUN/   JRUN, MULRUN, IGROUP
C
      COMMON /OPPLOT/ IPLADD(70), INTPLOT(70)
      LOGICAL         INTPLOT
C
      COMMON          C(3510)
C
      DIMENSION   IC(3510)
C
      EQUIVALENCE (C(0001), IC(0001) )
      EQUIVALENCE (C(2020), LCONV )
      EQUIVALENCE (C(2280), NV    )
C
      DIMENSION PLOTDATA(70)

C
C---  Write the STAT data:
C   
      IF( STAGEMET .OR.  LCONV .GT. 1 ) THEN 
C
C---    If a stage criteria has been met OR the end of the trajectory
C---    has been reached, then write the data to the STAT.* file 
C
        DO I = 1, NV 
          IF( INTPLOT(I) ) THEN
            PLOTDATA(I) = IC( IPLADD(I) ) 
          ELSE
            PLOTDATA(I) = C( IPLADD(I) )
          ENDIF
        ENDDO
C
        IF(STATBIN) WRITE(ID_STATBIN)  (PLOTDATA(I),I=1,NV),JRUN,IGROUP  
        IF(STATASC) WRITE(ID_STATASC,*)(PLOTDATA(I),I=1,NV),JRUN,IGROUP 
C
C---  At Dr. Zipfel's request, the code to create a tape45 was commented
C---  out. ( 29 Sep 1994.)
C          IF( LCONV .GT. 1 ) 
C     1        WRITE(45,*) ( PLOTDATA(I), I=1, NV )

C
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE OP3_RTWRITE
C
C-------------------------------------------------------------------------
C
C  This module writes the selected plot variable data to the TRACK.*.
C
C--Local Variable Definitions---------------------------------------------
C
C-------------------------------------------------------------------------
C
      DIMENSION PLOTDATA(70), IC(3510)
C
      COMMON    C(3510)
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /OPTRACK/  IPLTRACK(70), INTPTRACK(70), NTRACKVAR
      LOGICAL           INTPTRACK
C
      COMMON /OPTRACKC/ TRACKLAB
      CHARACTER         TRACKLAB(70)*8
C
      EQUIVALENCE (C(0001), IC(0001) )
C
C
C---  Insure that time is first.
      IPLTRACK(1) = 2000    
C
C---  Determine the data to print to the TRAJ.* files.
      DO I = 1, NTRACKVAR 
         IF( INTPTRACK(I) ) THEN
             PLOTDATA(I) = IC( IPLTRACK(I) ) 
         ELSE
             PLOTDATA(I) = C( IPLTRACK(I) )
         ENDIF
      ENDDO
C   
      IF( TRACKBIN ) WRITE(ID_TRACKBIN) (PLOTDATA(I), I=1,NTRACKVAR)
      IF( TRACKASC ) WRITE(ID_TRACKASC,*) (PLOTDATA(I), I=1,NTRACKVAR)
C
C
      RETURN
      END
      SUBROUTINE OP3_WR_TABOUT
C
C-------------------------------------------------------------------------
C
C  This module writes the selected scroll data to the tabular output at 
C  the user selected/requested print rates.
C
C--Local Variable Definitions---------------------------------------------
C
C-------------------------------------------------------------------------
C
C
      COMMON         C(3510)
C
      COMMON /OPFLAG/ INTMSG, STGMSGOUT, INECHO, XSWEEP
      LOGICAL         INTMSG, STGMSGOUT, INECHO, XSWEEP
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /KRUN/    JRUN, MULRUN, IGROUP
C
      COMMON /NAD/     IBEEN, IBEGIN, ICARD, ISAVE
C
      COMMON /OPSVAR/  ISCROL, KLOC(16), LPRT, IHEADP, INTS(16)
      LOGICAL          INTS
C
      COMMON /OPFLGC/ FMTSTRING, TRACE
      CHARACTER       FMTSTRING*85, TRACE(16)*8
C
      DIMENSION   DER(101), IC(3510)
C
      EQUIVALENCE (C(0001), IC(0001) )
      EQUIVALENCE (C(1801), CRITNO )
      EQUIVALENCE (C(1805), CRITMAX )
      EQUIVALENCE (C(2000), TIME ) 
      EQUIVALENCE (C(2003), PCNT )
      EQUIVALENCE (C(2015), CPP  )
      EQUIVALENCE (C(2020), LCONV  )
      EQUIVALENCE (C(2664), DER(1)  )
C
C
      DIMENSION PLOTDATA(70)
C
C
      IF( ISCROL .GT. 0 ) THEN 
C
C         Scroll is entered on the HEADER file.  Print output as
C         selected.
C
          IF( JRUN .LT. 2 )   THEN 
C
C             This is the first trajectory of a set.  Check to see
C             if should print data out.  Only print the time trajectory 
C             data for the first run of a monte carlo/multirun set.  
C             Don't print trajectories at other JRUN runs.
C             These  IF statements could
C             be combined, however separated hoping to keep execution
C             time minimal.  Perform simple test at each call then 
C             when get this criteria, perform more complex test.
C
              IF( .NOT. XSWEEP .OR.
     1            ( XSWEEP .AND. IGROUP .LT. 2 ) ) THEN
C
C              The case is NOT a sweep run   OR   the case is a sweep run 
C              and this is the first group/aimpoint
C 
               IF( TIME .GE. PCNT ) THEN 
C
C                  The time is greater than the print time.  Print the 
C                  data now.   Start by incrementing the line counter 
C                  to determine when the headers need to be printed.
C
                   IHEADP = IHEADP + 1  
C
                   IF( IHEADP .GT. 10 ) THEN
C
C---                   10 lines printed since last header display.  Print 
C---                   header display now. In order to avoid a blank line 
C---                   after the acronyms when 10 scroll variables are 
C---                   selected, the last variable is written without 
C---                   following blanks.
                       IF( LPRT .EQ. 10 )  THEN 
                         WRITE(ID_TABOUT, '( 1X, 9A8, A )' ) 
     1                   ( TRACE(II),II=1,LPRT-1 ), 
     2                   TRACE(LPRT)(1:LENSTR(TRACE(LPRT))) 
                       ELSEIF( LPRT .GT. 0 ) THEN 
                         WRITE(ID_TABOUT, '( 1X, 16A8 )' ) 
     1                   ( TRACE(II),II=1,LPRT )  
                       ENDIF
C
                       IHEADP = 0      ! Reset Counter
C
                   ENDIF
C                  
                   IF( LPRT .GT. 0 ) THEN
                     DO I = 1, LPRT
                        IF( INTS(I) ) THEN
                            PLOTDATA(I) = IC( KLOC(I) ) 
                        ELSE
                            PLOTDATA(I) = C( KLOC(I) )
                        ENDIF
                     ENDDO  
                   ENDIF
C   
C---               Print the data
                   IF( LPRT .GT. 0 ) 
     1             WRITE(ID_TABOUT,FMT=FMTSTRING) (PLOTDATA(I),I=1,LPRT)
C
C---               Calculate a test time for the next tabular data print.
C---               Allow a margin of error in case the Time is not exact
C---               due to (?) computer numeric representation ?
C
                   NUM_INTERVAL = AINT( 
     1                          ( TIME + 0.5 * DER(1) ) / CPP + 1.0 ) 
                   PCNT = NUM_INTERVAL * CPP - 0.5 * DER(1)
C
C---               Print the Real-Time TRACK data
                   CALL OP3_RTWRITE
C
               ENDIF 
C
            ENDIF 
          ENDIF 
C
      ENDIF 
C
C
      IF( LCONV .EQ. 2 ) THEN
C
C         Lconv = 2 =  End of trajectory either by PCA or by 
C         impact.  Write a message to the output file.
C
          ICRITNO = CRITNO
          CRITVAR = C( ICRITNO ) 
          WRITE(ID_TABOUT,100) C(2000), CRITVAR, JRUN, MULRUN, IGROUP
  100     FORMAT( ' FLT TIME = ', G10.3, ' CRIT VAR = ', G10.3, 
     1                  ' RUN ', I3, ' OF ', I3, ' RUNS  IN  GROUP', I3)  
          WRITE(ID_TABOUT,*) 
C
      ELSEIF( LCONV .GT. 2 ) THEN
C
C         Lconv > 2 = trajectory did not reach correct end
C
          ICRITNO = CRITNO
          CRITVAR = CRITMAX
          WRITE(ID_TABOUT,100) C(2000), CRITVAR, JRUN, MULRUN, IGROUP
          WRITE(ID_TABOUT,*) 
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE OP3_PF11( IUNIT )
C
C-------------------------------------------------------------------------
C
C  This module writes the -1.0 record to either the TRAJ.* or STAT.* 
C  plot file for separating sets of multiple/sweep trajectory data.
C
C--Argument List Definitions--------------------------------------------
C
C  IUNIT - (I) The unit number of the unit to be written to.
C      
C-------------------------------------------------------------------------
C
C
      COMMON           C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /KRUN/    JRUN, MULRUN, IGROUP
C
      DIMENSION   PMIN(70)
C            
C
      EQUIVALENCE (C(2127), PMIN(1) ) 
      EQUIVALENCE (C(2280), NV    )
C
C
      PMIN(1) = -1.0
C
      IF( IUNIT .EQ. ID_TRAJBIN ) THEN 
C                                       
C---      Write a -1.0 record to the binary trajectory file.
          WRITE( IUNIT )    ( PMIN(I), I=1, NV ) 
C
      ELSE IF( IUNIT .EQ. ID_TRAJASC ) THEN
C
C---      Write a -1.0 record to the ascii trajectory file.
          WRITE( IUNIT, * ) ( PMIN(I), I=1, NV ) 
C
      ELSE IF( IUNIT .EQ. ID_STATBIN ) THEN            
C
C---      Write a -1.0 record to the binary statistics file.
          WRITE( IUNIT )    ( PMIN(I), I=1, NV ), JRUN, IGROUP
      ELSE      
C
C---      Write a -1.0 record to the ascii statistics file.
          WRITE( IUNIT, * ) ( PMIN(I), I=1, NV ), JRUN, IGROUP
C          
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE SWEEPI
C
C-------------------------------------------------------------------------
C
C  This module calls the SWEEP methodologies as directed by type 19, 20,
C  and 21 cards.  A SWEEP run is indicxated when the SWEEP flag is set in
C  the HEAD.ASC header file.
C
C---SWEEP Methodoligies---------------------------------------------------
C
C  Mode 0: Constant Delta                                ISWEEP = 0
C  Mode 1: Increasing Range in Decreasing Step Size      ISWEEP = 1
C  Mode 2: Decreasing Range in Increasing Step Size      ISWEEP = 2
C  Mode 3: Increasing/Decreasing Step Size               ISWEEP = 3
C  Mode 4: Outer Boundary Test                           ISWEEP = 4
C  Mode 5: All Boundary Test                             ISWEEP = 5
C
C-------------------------------------------------------------------------
C
      COMMON C(3510)
C
      COMMON /OPFLAG/ INTMSG, STGMSGOUT, INECHO, XSWEEP
      LOGICAL         INTMSG, STGMSGOUT, INECHO, XSWEEP
C
      DIMENSION KSEE(3510)
C
      EQUIVALENCE (C(0001), KSEE(1) )
      EQUIVALENCE (C(1800), ISWEEP )
C
      IF( XSWEEP ) THEN      
C
C---  CALL SWEEP METHODOLOGIES
C
         IF(ISWEEP.EQ.5) THEN 
C
C---       SWEEP Methodology 5: ALL BOUNDARY TEST
           CALL SWEEP5_METHOD
C
           ELSEIF(ISWEEP.EQ.4) THEN 
C
C---       SWEEP Methodology 4: OUTER BOUNDARY TEST 
           CALL SWEEP4_METHOD
C
           ELSEIF(ISWEEP.EQ.3) THEN 
C
C---       SWEEP Methodology 3: INCREASING/DECREASING STEP SIZE
           CALL SWEEP3_METHOD
C
           ELSEIF(ISWEEP.EQ.2) THEN 
C
C---       SWEEP Methodology 2: DECREASING RANGE IN INCREASING STEP SIZE
           CALL SWEEP2_METHOD
C
           ELSEIF(ISWEEP.EQ.1) THEN 
C
C---       SWEEP Methodology 1: INCREASING RANGE IN DECREASING STEP SIZE
           CALL SWEEP1_METHOD
C
           ELSEIF(ISWEEP.EQ.0) THEN 
C
C---       SWEEP Methodology 0: CONSTANT DELTA 
           CALL SWEEP0_METHOD
C
           ENDIF
C
	  ENDIF
C
      RETURN
      END
      FUNCTION RAYLEIGH( SIG )
C
C-----------------------------------------------------------------------
C
C    RAYLEIGH = X E**-( X**2 / SIG**2 *2 ) / SIG ** 2
C
C    MEAN = SIG * SQRT( PI / 2 )
C
C    VARIANCE = SIG**2 * ( 2 - PI / 2 )
C
C    RAYDEV ~ RAYLEIGH( SQRT(PI/2), (2-PI/2) )
C
C    Multiplying by sigma gives a mean of SIG*SQRT(PI/2) and a 
C    variance of SIG**2 ( 2-PI/2 )
C
C-----------------------------------------------------------------------
C
      RAYLEIGH = RAYDEV() * SIG
C
      RETURN
      END
C
C-----------------------------------------------------------------------
C
      FUNCTION RAYDEV()
C
C-----------------------------------------------------------------------
C
C     RAYDEV - function to generate a random variable with a
C              RAYLEIGH distribution with a mean and variance
C              of ( SQRT(PI/2), (2-PI/2) ) using a uniform random 
C              function with a mean of (0,1).
C
C            ( returns a RAYLEIGH distributed, positive, random 
C              deviate of PI/2 mean and (2-PI/2) using RANF() as 
C              the source of uniform deviates )
C
C     The deviate is found by finding the inverse of the indefinate 
C     integral of the pdf. ie. If the pdf is given by f(y), the 
C     indefinate integral of f(y) is F(y).  The deviate is then the 
C     inverse of F(y).
C
C      The Rayleigh is:
C
C         ( X / alpha**2 ) * exp( - X**2 / ( 2 * alpha**2) )
C
C      With an alpha of 1, we get:
C
C         X * exp( - X**2 / 2 )
C
C      The indefinite integral is:
C         
C        exp( -X**2 / 2 )
C
C      The inverse is then:
C
C         SQRT( -2 * LN(Y) )      
C
C      Where y is a uniformly distributed random variable.
C
C
C      For an indepth discussion of finding the deviate of a distribution
C      refer to Numerical Recipes: The Art of Scientific Computing by 
C      Press, Flannery, Teukolsky, and Vetterling.
C
C-----------------------------------------------------------------------
C
      RAYDEV = SQRT( 2.0 * ( - 1.0 * ALOG( RANF() )  ) )
C
      RETURN
      END
C---NOTE: This FUNCTION was included in the UTL.FOR file (and commented out here)
C         to remove an error that occurred during the execution of the RT CADAC model.
C         [BC 28 May 98]
CBC      REAL*4  FUNCTION RANF()            !  "Subroutine"
C
C-------------------------------------------------------------------------
C  
C   This module generates a uniform random variable between 0 and 1, 
C   exclusive of both 0 and 1.  This module was written because the
C   ranf function normally supplied with uVax and Vax systems was 
C   generating an overflow error when passed valid seeds.  This module
C   also allows the user's to program modules requiring RANF but they
C   do not require access to the seed and this prevents them from
C   un-intentionally modifing the seed.
C
C-------------------------------------------------------------------------
C  
CBC      CALL RANDOM( RVALUE )
C
C---  MS's RANDOM subroutine generates values >= 0 and < 1, 0-inclusive.
CBC
CBC      DO WHILE( RVALUE .EQ. 0.0 )
CBC         CALL RANDOM( RVALUE )
CBC      ENDDO
C
CBC      RANF = RVALUE
C
C
CBC      RETURN
CBC      END
      SUBROUTINE RDH1_HEADR( NPLOTVAR )
C
C-------------------------------------------------------------------------
C  
C  This module opens the Head.ASC input file, determines if the user 
C  has entered scroll or noscroll; if scroll is selected, the scroll 
C  variables and format are determined; then the plot variable list is read 
C  from the file.
C
C--Argument List Definitions-------------------------------------------
C
C  NPLOTVAR - (I) Output. Counts the number of variables as they are 
C             added to the plot list.  Used in EXEC to initialize the 
C             common location for each run.
C  
C--Local Variable Definitions-------------------------------------------
C
C  INLINE - (80) An 80 character string used to read a record from the 
C           Head.ASC file.
C
C-------------------------------------------------------------------------
C   
      COMMON /OPFLAG/ INTMSG, STGMSGOUT, INECHO, XSWEEP
      LOGICAL         INTMSG, STGMSGOUT, INECHO, XSWEEP
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /OPSVAR/  ISCROL, KLOC(16), LPRT, IHEADP, INTS(16)
      LOGICAL          INTS                    
C
C
      INTEGER   GETENVQQ
      CHARACTER INLINE*150, FILENAME*50
C
C
C
C---  Initialize variables.
C
      IHEADP = 0     ! Output line counter for placing header lines
C
C---  Open and start processing the Head.ASC file.
C
C---  Check to see if the filename for the input file HEAD.ASC 
C---  was set using an enviroment variable.  If so, translate the 
C---  environment variable. If the variable is undefined (the value of
C---  LENGTH is 0) set the file name to the default. 
C---      LENGTH = GETENVQQ( 'HEAD', FILENAME )
      LENGTH = 0
      IF( LENGTH .EQ. 0 ) FILENAME = 'HEAD.ASC'
C
C---  Open the head.asc file.
C---      OPEN( UNIT=ID_HEAD, FILE = FILENAME( 1: LENSTR(FILENAME) ),
C---     1      STATUS='OLD', ERR=999, MODE='READ' )
      OPEN( UNIT=ID_HEAD, FILE = 'HEAD.ASC' )
C
C---  Read the first line of the Head.ASC and determine whether the 
C---  word SCROLL or NOSCROLL is included on the record.  
C---  This determines whether the data is scrolled during CADAC 
C---  execution on the terminal screen or not scrolled.
C
      READ(ID_HEAD,100) INLINE 
  100 FORMAT(A)
C
C
      CALL STR_UPCASE( INLINE, INLINE )
C
C-------------------------------------------------
C
C---  Determine if the input is to be echoed on the output or not.
C---  Set the flag accordingly.
      INECHO = .FALSE.
      IFOUND = INDEX( INLINE, 'NOECHOIN' ) 
      IF( IFOUND .EQ. 0 ) THEN
        IFOUND = INDEX( INLINE, 'ECHOIN' ) 
        IF( IFOUND .GT. 0 ) INECHO = .TRUE.
      ENDIF
C
C
C---  Determine if staging messages are to be echoed on the output or not.
C---  Set the flag accordingly.
      STGMSGOUT = .FALSE.
      IFOUND = INDEX( INLINE, 'NOSTGMSG' ) 
      IF( IFOUND .EQ. 0 ) THEN 
        IFOUND = INDEX( INLINE, 'STGMSG' ) 
        IF( IFOUND .GT. 0 ) STGMSGOUT = .TRUE.
      ENDIF
C
C---  Determine if the Integration messages are to be echoed on the 
C---  output or not.  Set the flag accordingly.
      INTMSG = .FALSE.
      IFOUND = INDEX( INLINE, 'NOINTMSG' ) 
      IF( IFOUND .EQ. 0 ) THEN 
        IFOUND = INDEX( INLINE, 'INTMSG' ) 
        IF( IFOUND .GT. 0 ) INTMSG = .TRUE.
      ENDIF
C
C---  Determine if a binary trajectory file is to be created.   
      TRAJBIN = .FALSE.
      IFOUND = INDEX( INLINE, 'NOTRAJBIN' ) 
      IF( IFOUND .EQ. 0 ) THEN 
        IFOUND = INDEX( INLINE, 'TRAJBIN' ) 
        IF( IFOUND .GT. 0 ) TRAJBIN = .TRUE.
      ENDIF
C
C---  Determine if an ASCII trajectory file is to be created.   
      TRAJASC = .FALSE.
      IFOUND = INDEX( INLINE, 'NOTRAJASC' ) 
      IF( IFOUND .EQ. 0 ) THEN 
        IFOUND = INDEX( INLINE, 'TRAJASC' ) 
        IF( IFOUND .GT. 0 ) TRAJASC = .TRUE.
      ENDIF
C
C---  Determine if an binary statistics file is to be created.   
      STATBIN = .FALSE.
      IFOUND = INDEX( INLINE, 'NOSTATBIN' ) 
      IF( IFOUND .EQ. 0 ) THEN 
        IFOUND = INDEX( INLINE, 'STATBIN' ) 
        IF( IFOUND .GT. 0 ) STATBIN = .TRUE.
      ENDIF
C
C---  Determine if an ASCII statistics file is to be created.   
      STATASC = .FALSE.
      IFOUND = INDEX( INLINE, 'NOSTATASC' ) 
      IF( IFOUND .EQ. 0 ) THEN 
        IFOUND = INDEX( INLINE, 'STATASC' ) 
        IF( IFOUND .GT. 0 ) STATASC = .TRUE.
      ENDIF
C
C---  Determine if an ASCII RT initialization file is to be created.   
      INITASC = .FALSE.
      IFOUND = INDEX( INLINE, 'NOINITASC' ) 
      IF( IFOUND .EQ. 0 ) THEN 
        IFOUND = INDEX( INLINE, 'INITASC' ) 
        IF( IFOUND .GT. 0 ) THEN
            IF( .NOT. INITBIN ) INITASC = .TRUE.
        ENDIF
      ENDIF
C
C---  Determine if an binary RT initialization file is to be created.   
      INITBIN = .FALSE.
      IFOUND = INDEX( INLINE, 'NOINITBIN' ) 
      IF( IFOUND .EQ. 0 ) THEN 
        IFOUND = INDEX( INLINE, 'INITBIN' ) 
        IF( IFOUND .GT. 0 ) THEN
            IF( .NOT. INITASC ) INITBIN = .TRUE.
        ENDIF
      ENDIF
C
C---  Determine if an ASCII RT track data file is to be created.   
      TRACKASC = .FALSE.
      IFOUND = INDEX( INLINE, 'NOTRACKASC' ) 
      IF( IFOUND .EQ. 0 ) THEN 
        IFOUND = INDEX( INLINE, 'TRACKASC' ) 
        IF( IFOUND .GT. 0 ) THEN 
            IF( .NOT. TRACKBIN ) TRACKASC = .TRUE.
        ENDIF
      ENDIF
C
C---  Determine if an binary RT track data file is to be created 
      TRACKBIN = .FALSE.
      IFOUND = INDEX( INLINE, 'NOTRACKBIN' ) 
      IF( IFOUND .EQ. 0 ) THEN 
        IFOUND = INDEX( INLINE, 'TRACKBIN' ) 
        IF( IFOUND .GT. 0 ) THEN
            IF( .NOT. TRACKASC ) TRACKBIN = .TRUE.
        ENDIF
      ENDIF
C
C---  Determine if the tabular output is written to the screen (TABOUT=F)
C---  or to a file (TABOUT=T)
      TABOUT = .FALSE.   
      IFOUND = INDEX( INLINE, 'NOTABOUT' ) 
      IF( IFOUND .EQ. 0 ) THEN 
        IFOUND = INDEX( INLINE, 'TABOUT' ) 
        IF( IFOUND .GT. 0 ) TABOUT = .TRUE.
      ENDIF  
C
C---  Determine if the Random data assigned to variables by the type 3 
C---  and 11 cards are to be displayed to the RANSEL data file (unit 37) 
C---  Set the flag accordingly.   
      RANVAR = .FALSE.
      IFOUND = INDEX( INLINE, 'NORANVAR' ) 
      IF( IFOUND .EQ. 0 ) THEN 
        IFOUND = INDEX( INLINE, 'RANVAR' ) 
        IF( IFOUND .GT. 0 ) RANVAR = .TRUE.
      ENDIF
C
C---  Determine if a SWEEP run will be executed
      XSWEEP = .FALSE.
      IFOUND = INDEX( INLINE, 'NOSWEEP' )
      IF( IFOUND .EQ. 0 ) THEN
          IFOUND = INDEX( INLINE, 'SWEEP' )
          IF( IFOUND .GT. 0 ) XSWEEP = .TRUE.
      ENDIF
C
C---  Determine if the output is to be generated or suppressed.
      IFOUND = INDEX( INLINE, 'NOSCROLL' ) 
C     
      IF( IFOUND .GT. 0 ) THEN 
C 
C---      "Noscroll" was on the header record.
          ISCROL = 0    ! Set the scroll flag = null.
          LPRT   = 0    ! Number of scroll variables.
C
      ELSE
C      
C---      "Scroll" or neither keyword was on the first record of header.
          ISCROL = 1
          CALL RDH1_SCROLL
C
      ENDIF
C
C
C---  Read the list of variables to print to the TRAJ.*/STAT.* files.
      CALL RDH1_PVAR( NPLOTVAR )
C
C
C---  Close the Head.ASC file.
      CLOSE(ID_HEAD)
C
C---  End of the module.
      RETURN
C
C
C---  Open statement error messages:
  999 CONTINUE
C
      WRITE(ID_TABOUT,*) '  '
      WRITE(ID_TABOUT,*) ' *** Could not open HEAD.ASC data file ***'
      WRITE(ID_TABOUT,*) '  '
C
      STOP
      END
      SUBROUTINE RDH1_SCROLL 
C
C-------------------------------------------------------------------------
C  
C  This module reads the scroll variable list from the Head.ASC file.
C
C--Local Variable Definitions-------------------------------------------
C
C  ASKE    - (C1) The first character of the Head.ASC records - used to 
C            check if an asterisk is punched in column 1. 
C  FORSCROL- (C1) If non-blank, contains an integer indicating the number 
C            of digits to the right of the decimal to use in the format 
C            statment when writting this variable.  If "I" or " ", prints 
C            the variable with 0 digits to the right of the decimal.
C  IFORMAT - (I) Integer value of the character in FORSCROL.
C  I1      - (I) Pointer into the format character string, FMTSTRING, 
C            prior to adding the current scroll variable's format
C  I2      - (I) Pointer into the format character string, FMTSTRING, after 
C            the addition of the current scroll variable's format.
C
C-------------------------------------------------------------------------
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /OPSVAR/  ISCROL, KLOC(16), LPRT, IHEADP, INTS(16)
      LOGICAL          INTS
C
      COMMON /OPFLGC/  FMTSTRING, TRACE
      CHARACTER        FMTSTRING*85, TRACE(16)*8
C
C
      CHARACTER FORSCROL*1, ASKE*1
C
C
C     Initialize variables for determing the scroll variables 
C     and their format.
C
      FMTSTRING = '  '
      FMTSTRING(1:1) = '('
      I1 = 2             ! Initialize format pointer 1.
      I2 = I1 + 4        ! Initialize format pointer 2.
C
      LPRT = 0           ! Number of scroll variables.
C
C
C---  Start of the loop for reading the variables:
  160 CONTINUE
C
C---    Increment the scroll variable counter:
        LPRT = LPRT + 1 
C
C---    Read the next HEAD.ASC record.
        READ(ID_HEAD,180) ASKE, FORSCROL, KLOC(LPRT), TRACE(LPRT)
  180   FORMAT( A1, 1X, A1, 1X, I4, 4X, A8 )
C
C
C---    Initialize the integer flag to indicate a real variable.
        INTS( LPRT ) = .FALSE. 
C
        IF( ASKE .EQ. '*' ) THEN
C
C---        The first character is an asterisk, the end of the 
C---        scroll records has been reached.  Stop reading the 
C---        scroll variables.  Adjust the scroll variables counter.
            LPRT = LPRT - 1
C
        ELSE
C
C           Check for the integer scale value:
C
            IF( FORSCROL .EQ. 'I') THEN
C
C               Integer variable:  Set the flag in the array and 
C               print this variable with 0 digits to the right of 
C               the decimal.
C                                     
                IF( LPRT .GT. 1 ) THEN
                  FMTSTRING(I1:I2) = 'F8.0' // ','  
                ELSE
                  FMTSTRING(I1:I2) = 'F7.0' // ','  
                ENDIF
                INTS( LPRT ) = .TRUE.
C
            ELSEIF( FORSCROL .EQ. ' ') THEN
C
C               Print this variable with 0 digits to the right of the 
C               decimal.
C                              
                IF( LPRT .GT. 1 ) THEN
                  FMTSTRING(I1:I2) = 'F8.0' // ',' 
                ELSE   
                  FMTSTRING(I1:I2) = 'F7.0' // ','  
                ENDIF
C
            ELSE
C
                READ( FORSCROL, '(I1)', ERR = 200 ) IFORMAT
CVAX                  READ( FORSCROL, *, ERR = 200 ) IFORMAT
                GOTO 220
C
  200           CONTINUE
C
C                   Error occurred during read of format character.
C
                    FORSCROL = '5'
                    IFORMAT = 5
C
C
  220           CONTINUE
C
                IF( IFORMAT .LT. 0  .OR.  IFORMAT .GT. 5 ) THEN
                    FORSCROL = '5'
                    IFORMAT = 5
                ENDIF
C
C               Print the real variable with the number of significant 
C               digits specified by the input file.
C                                                  
                IF( LPRT .GT. 1 ) THEN
                  FMTSTRING(I1:I2) = 'F8.' // FORSCROL // ',' 
                ELSE
                  FMTSTRING(I1:I2) = 'F8.' // FORSCROL // ','   
                ENDIF
C                
            ENDIF
C
C           Update pointers into the format character variable.
C
            I1 = I2 + 1
            I2 = I1 + 4
C           
C           Continue this loop until 16 scroll variables have been read. 
C
            IF( LPRT .LT. 16 ) GOTO 160 
C
        ENDIF
C
C---  End of scroll variables or reached the maximum allowed.
C
C     Finish the format statement for the scroll variables.
C     NOTE: Write over the comma inserted after the last added format 
C     descriptor.
C
      FMTSTRING( I1-1 : I1 ) = ') '
C
C
      RETURN
      END
      SUBROUTINE RDH1_PVAR( NPLOTVAR )
C
C-------------------------------------------------------------------------
C  
C  This module reads the parameter definitions list and loads the array
C  with the variable numbers to be printed to the TRAJ.*/STAT.* files.
C  The variables are marked for inclusion in the plot files by placing a
C  space in column 1 and an asterisk in column 2.
C
C--Argument List Definitions-------------------------------------------
C
C  NPLOTVAR - (I) Output. Counts the number of variables as they are 
C             added to the plot list.  Used in EXEC to initialize the 
C             common location for each run.
C
C--Local Variable Definitions-------------------------------------------
C
C  ASKE    - (C1) The first character of the Head.ASC records - used to 
C            check if an asterisk is punched in column 1. 
C            Also used to see if the variable is to be written to a
C            RT CADAC file: INIT.*/TRACK.* (implemented under task
C            XR 97 - Real-Time CADAC.)
C  KPL     - (I) Global common C location of the scroll variable as read 
C            from the parameter definitions list.
C  ALA     - (C8) Variable parameter name (acronym) as read from the 
C            parameter definitions list.
C  FORMAT  - (C1) A character variable read from the head.ASC record.  
C            If 'I', indicates that the variable is an integer; 
C            otherwise, it is a real. 
C
C
C-------------------------------------------------------------------------
C  
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /OPPLOT/  IPLADD(70), INTPLOT(70)
      LOGICAL          INTPLOT
C
      COMMON /OPPLTC/  ALABLE
      CHARACTER        ALABLE(70)*8
C
      COMMON /OPINIT/  IPLINIT(70), INTPINIT(70), NINITVAR
      LOGICAL          INTPINIT
C
      COMMON /OPINITC/ INITLAB
      CHARACTER        INITLAB(70)*8
C
      COMMON /OPTRACK/  IPLTRACK(70), INTPTRACK(70), NTRACKVAR
      LOGICAL           INTPTRACK
C
      COMMON /OPTRACKC/ TRACKLAB
      CHARACTER         TRACKLAB(70)*8
C
      CHARACTER INLINE*80, ASKE*1, FORMAT*1, ALA*8
C
C
C---  Initialize the plot variable storage counter and arrays.  Always 
C---  include TIME( = C(2000) ) as the first variable on the plot file.
      NPLOTVAR = 1
      IPLADD(1) = 2000
      ALABLE(1) = 'TIME    '
C
      NINITVAR = 1    ! Number of initialization variables
      NTRACKVAR = 1   ! Number of track data file variables
      IPLINIT(1) = 2000
      IPLTRACK(1) = 2000
      INITLAB(1) = 'TIME    '
      TRACKLAB(1) = 'TIME    '
C
C---  Read the parameter definitions list.  These cards must start with 
C---  a blank in column 1.  Search through the list to find the 
C---  variables that must be placed in the plot file.  The search 
C---  continues until 70 variables have been found or the EOF is reached.
C
C---  Read past any comment records until the parameter definitions 
C---  list is reached.
      READ(ID_HEAD,100) INLINE 
      DO WHILE( INLINE(1:1) .EQ. '*' ) 
         READ(ID_HEAD,100) INLINE 
      ENDDO
C
C
C---  A plot variable definition has been found process the data.
   60 CONTINUE
C
C--- Changed this test for valid record to NE '*' since a T, I, or B in
C    column 1 is a valid record.  This indicates output to the RT CADAC
C    Track data file, Initialization file, or Both.  Implemented under
C    task XR97 - Real-Time CADAC
      IF( INLINE(1:1) .NE. '*') THEN
C---      A valid card has been found.  Read the data from the card.
C
          READ( INLINE(2:80), 280 ) ASKE, FORMAT, KPL, ALA
  280     FORMAT( A1, A1, 1X, I4, 4X, A8 )
C
          IF( INLINE(1:1) .EQ. 'B' .OR. INLINE(1:1) .EQ. 'b' ) THEN
              IF( NINITVAR .GT. 69 ) INLINE(1:1) = 'T'
              IF( NTRACKVAR .GT. 69 ) INLINE(1:1) = 'I'
          ENDIF
C
C
              IF( ASKE .EQ. '*' ) THEN
C              
C---              The second column of the card contained an asterisk.
C---              Capture this parameter for plotting.
                  IF( KPL .NE. 2000 ) THEN
C
C---                  The selected variable is not the TIME ( C(2000) ) 
C---                  variable which has already been added to the list.  
C---                  So add this variable to the list for plotting.  Save 
C---                  the label also.
                      NPLOTVAR = NPLOTVAR + 1
                      IPLADD( NPLOTVAR ) = KPL
                      ALABLE( NPLOTVAR ) = ALA
C
C---                  Set the integer flag array to indicate which plot
C---                  variables are integers.
                      IF( FORMAT .EQ. 'I' ) THEN
                          INTPLOT( NPLOTVAR ) = .TRUE.
                      ELSE
                          INTPLOT( NPLOTVAR ) = .FALSE. 
                      ENDIF  
C                 
                  ENDIF
C
C---              Check if the maximum number of plot variables has been 
C---              reached.  Once 70 variables are listed, end the search 
C---              for plot variables.
                  IF( NPLOTVAR .GT. 69 ) RETURN
C
              ENDIF
C
          ENDIF
          IF( INLINE(1:1) .EQ. 'I' .OR. 
     1        INLINE(1:1) .EQ. 'i' ) THEN
C
C---          This variable is to be written to the RT initialization file
                  IF( KPL .NE. 2000 ) THEN
C
C---                  The selected variable is not the TIME ( C(2000) ) 
C---                  variable which has already been added to the list.  
C---                  So add this variable to the list for plotting.  Save 
C---                  the label also.
                      NINITVAR = NINITVAR + 1
                      IPLINIT( NINITVAR ) = KPL
                      INITLAB( NINITVAR ) = ALA
C
C---                  Set the integer flag array to indicate which plot
C---                  variables are integers.
                      IF( FORMAT .EQ. 'I' ) THEN
                          INTPINIT( NINITVAR ) = .TRUE.
                      ELSE
                          INTPINIT( NINITVAR ) = .FALSE. 
                      ENDIF  
C                 
                  ENDIF
C
C---              Check if the maximum number of plot variables has been 
C---              reached.  Once 70 variables are listed, end the search 
C---              for plot variables.
                  IF( NINITVAR .GT. 69 ) RETURN
C
          ELSEIF( INLINE(1:1) .EQ. 'T' .OR. 
     1            INLINE(1:1) .EQ. 't' ) THEN
C
C---          This variable is to be written to the RT track data file
                  IF( KPL .NE. 2000 ) THEN
C
C---                  The selected variable is not the TIME ( C(2000) ) 
C---                  variable which has already been added to the list.  
C---                  So add this variable to the list for plotting.  Save 
C---                  the label also.
                      NTRACKVAR = NTRACKVAR + 1
                      IPLTRACK( NTRACKVAR ) = KPL
                      TRACKLAB( NTRACKVAR ) = ALA
C
C---                  Set the integer flag array to indicate which plot
C---                  variables are integers.
                      IF( FORMAT .EQ. 'I' ) THEN
                          INTPTRACK( NTRACKVAR ) = .TRUE.
                      ELSE
                          INTPTRACK( NTRACKVAR ) = .FALSE. 
                      ENDIF  
C                 
                  ENDIF
C
C---              Check if the maximum number of plot variables has been 
C---              reached.  Once 70 variables are listed, end the search 
C---              for plot variables.
                  IF( NTRACKVAR .GT. 69 ) RETURN
C
          ELSEIF( INLINE(1:1) .EQ. 'B' .OR. 
     1            INLINE(1:1) .EQ. 'b' ) THEN
C
C---          This variable is to be written to the RT initialization and
C             track data file
                  IF( KPL .NE. 2000 ) THEN
C
C---                  The selected variable is not the TIME ( C(2000) ) 
C---                  variable which has already been added to the list.  
C---                  So add this variable to the list for plotting.  Save 
C---                  the label also.
                      NINITVAR = NINITVAR + 1
                      IPLINIT( NINITVAR ) = KPL
                      INITLAB( NINITVAR ) = ALA
C
                      NTRACKVAR = NTRACKVAR + 1
                      IPLTRACK( NTRACKVAR ) = KPL
                      TRACKLAB( NTRACKVAR ) = ALA
C
C---                  Set the integer flag array to indicate which plot
C---                  variables are integers.
                      IF( FORMAT .EQ. 'I' ) THEN
                          INTPINIT( NINITVAR ) = .TRUE.
                          INTPTRACK( NTRACKVAR ) = .TRUE.
                      ELSE
                          INTPINIT( NINITVAR ) = .FALSE.
                          INTPTRACK( NTRACKVAR ) = .FALSE. 
                      ENDIF  
C                 
                  ENDIF
C
C---              Check if the maximum number of plot variables has been 
C---              reached.  Once 70 variables are listed, end the search 
C---              for plot variables.
                  IF( NINITVAR .GT. 69 .AND. NTRACKVAR .GT. 69 ) RETURN
C
          ENDIF
C
C---  Read the next record and continue processing the records, 
C---  searching for the variable to be placed in the plot file. 
      READ(ID_HEAD,100,END=340) INLINE
  100 FORMAT(A)
C
C---  Go process the record.
      GOTO 60
C
C
C---  End of the search for plot variables.
  340 CONTINUE
C
C
      RETURN
      END
      SUBROUTINE RDI1_INIT_CARDS
C
C-------------------------------------------------------------------------
C
C  This module rewinds the input file (unit 35); performs reads to the 
C  file and acquires the primary trajectory data (all cards until the 
C  first type 6 or 12 card.  The input data is stored into the storage
C  arrays until it is ready to be processed by other modules.
C
C--Local Variable Definitions-------------------------------------------
C
C  NTEST - (I) Number of test cards following a type 10 card: Either 1 
C          or 2.  There must be at least 1 stage card following the type 
C          10 card but NTEST may be blank/zero for this case.
C
C-------------------------------------------------------------------------
C
      COMMON C(3510) 
C
      COMMON /OPFLAG/ INTMSG, STGMSGOUT, INECHO, XSWEEP
      LOGICAL         INTMSG, STGMSGOUT, INECHO, XSWEEP
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /WSET/    NCARD, JTYPE(500), LOCA(500), MOE(500), 
     1                 VA1(500), VA2(500), M2(500)
C
      COMMON /WSETC/   AL(3,500), HOLL(5)
      CHARACTER        AL*6, HOLL*80
C
      COMMON /NAD/     IBEEN, IBEGIN, ICARD, ISAVE
C
C
C
C
C---  Start reading the input cards from the input card deck (35) 
C---  and read them until the first card type 6 or 12 is detected.
C---  The input tape is rewound and the primary trajectory data is 
C---  read.
      CALL RDI1_PRIM_TRAJ
C
C
      IF( XSWEEP ) RETURN
C
C
      II = 1
      IF( ISAVE .GE. 1 ) II = ICARD
C
      DO I = II, NCARD
C
        IF( JTYPE(I) .EQ. 9 )  THEN
C
C---      Card type 9, write the header cards to output.
          NUMHOL = LOCA(I)       
          WRITE(ID_TABOUT,'(1X,A80)') (HOLL(N),N=1,NUMHOL) 
C
        ENDIF
C
      ENDDO
C
C
      RETURN
      END
      SUBROUTINE RDI1_PRIM_TRAJ
C
C-------------------------------------------------------------------------
C
C  This module reads the input card deck (35) until the first card of 
C  type 6 or 12 is reached.  These cards are stored into the arrays:
C  JTYPES, MODS, LOCS, etc.  This data will be utilized for each traj 
C  calculation.  
C
C--Local Variable Definitions-------------------------------------------
C
C  EOF_RCHD - (L) Indicates when the end of file has been reached.
C  ICRD     - (I) A card counter for the number of initialization cards 
C                 read from the input file (35)
C  NSTG     - (I) The number of stages found in the initialization card 
C                 deck.
C
C-------------------------------------------------------------------------
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /HCOM/    TITLE
      CHARACTER        TITLE*100 
C
      COMMON /IPSAV/   NCARDS, NHOL, JTYPES(500), LOCS(500), MODS(500), 
     1                 VA1S(500), VA2S(500), MOD2(500)

      COMMON /IPSAVC/  ALS(3,500), HOLS(5)
      CHARACTER        ALS*6, HOLS*80
C
      COMMON /IPSVSC/  MCRIS(20,2,4), VALS(20,2)
C
      COMMON /IPSVSCC/ MCRISC(20,2,2)
      CHARACTER        MCRISC*6
C
      COMMON /IPSVWD/  NWX, WXS(6,50)
C
C
      CHARACTER COMMENT*80,    ! Comment (character string) from card type 4
     1          CADIN_LINE*80  ! CADIN.ASC record producing error
C
      LOGICAL EOF_RCHD 
C
      DATA MAXSTAGE/ 20 /, MAXCARD/ 500 /
C
C
C
      NSTG = 0    ! Initialize the stage counter.
C
C---  Rewind the input file and read the title.
      REWIND ( ID_CADIN )
C
      READ( ID_CADIN,'(A)',END=120) TITLE(1:72)    
  120 CONTINUE
C
C
      ICRD = 0    ! Initialize the card counter.
C
C
C
  140 CONTINUE
C
C     Read the next input record.
C
      ICRD = ICRD + 1
C
      IF( ICRD .GT. MAXCARD ) THEN 
        WRITE(ID_TABOUT,*) ' '
        WRITE(ID_TABOUT,*) 
     1  ' Maximum number of initialization cards input.'
        WRITE(ID_TABOUT,*) ' RUN ABORTED '
        WRITE(ID_TABOUT,*) ' '
C
        STOP 
      ENDIF
C
C---  Set the endof file flag to true prior to the read.
      EOF_RCHD = .TRUE.
C
C---  Read the card data
      READ(ID_CADIN,160,END=180,ERR=900) JTYPES(ICRD), 
     1             ( ALS(J,ICRD),J=1,3 ), LOCS(ICRD), MODS(ICRD),
     2             VA1S(ICRD), VA2S(ICRD), MOD2(ICRD)
  160 FORMAT( I2, 3A6, 2I5, 2E15.9, I2 )  
C  
C---  If the read was successful, then set the endoffile flag to 
C---  false.  This assignment will be skipped if the end of file 
C---  is reached, leaving the value of eof_reached at true.
      EOF_RCHD = .FALSE. 
C
C
  180 CONTINUE           
C
      IF( EOF_RCHD .AND. ICRD .LT. 2 ) THEN
C
C---      Check for an end of file after only 2 reads:  Not enough 
C---      input data to perform an execution so exit.
C
          WRITE(ID_TABOUT,*) ' '
          WRITE(ID_TABOUT,*)
     1    ' End of file reached after only 2 input cards'
          WRITE(ID_TABOUT,*) ' Not sufficient input for execution '
          WRITE(ID_TABOUT,*) ' RUN ABORTED '
          WRITE(ID_TABOUT,*) ' '
C
          STOP ' '
      ENDIF
C
C
C     Card type 13 = stop trajectory.  If this is entered, then stop the 
C     program; do what the user requested.
C
      IF( JTYPES(ICRD) .EQ. 13 ) THEN
C
          WRITE(ID_TABOUT,*) '  '
          WRITE(ID_TABOUT,*) ' Card type 13 input.  '
          WRITE(ID_TABOUT,*) ' RUN STOPPED '
          STOP ' '
C
C
      ELSEIF( JTYPES(ICRD) .EQ. 16 ) THEN
C
          CALL RDI1_16CARD( ISTAT, ICRD, NSTG  ) 
C
          IF( ISTAT .NE. 0 ) THEN
C
C             Type 6 or 12 card encountered and variables already prepared.
C             Return to start trajectory calculations.
C
              RETURN
          ELSE
C
C             Type 10 card encountered.  End of stage data reached.  Go
C             read new data.
C
              GOTO 140
          ENDIF
C
      ELSEIF( JTYPES(ICRD) .EQ. 12 ) THEN
C
C         Ncards is the number of cards in the storage arrays.  
C         Set this value.
C         Type 12 card : don't include this card in the 
C         storage deck.
C
          NCARDS = ICRD - 1
C
C         Shift the data from the storing arrays into the 
C         working arrays.
C
          CALL WORK
C
C         The end of the initialization cards has been reached.  
C         Return and start the trajectory up to this point.
C
          RETURN
C
C
      ELSEIF( JTYPES(ICRD) .EQ. 7 ) THEN 
C
C          Card type = 7 : Vector initialization card .
C          Read the following special card types.
C
           CALL RDI1_7DATA( MODS(ICRD), NSTG, VA1S(ICRD), VA2S(ICRD) )
C
C
      ELSEIF( JTYPES(ICRD) .EQ. 8 ) THEN 
C
C          Card type = 8 :  Atmospheric Data follows this card.
C          Read in this data.
C
           CALL RDI1_ATMOSPHR( NWX, WXS )
C
C
      ELSEIF( JTYPES(ICRD) .EQ. 9 ) THEN
C
C             Card type = 9 :  Header cards follow.  Read this data.
C
              NHOL = LOCS(ICRD)   ! Number of header cards following.
C
              READ(ID_CADIN,'(A80)',END=320) ( HOLS(K), K=1, NHOL )
  320         CONTINUE
C
      ELSEIF( JTYPES(ICRD) .EQ. 10 ) THEN
C
              CALL RDI1_10CARD( NSTG, LOCS(ICRD), MCRIS, MCRISC, VALS )
C             
              IF( NSTG .GT. MAXSTAGE ) THEN 
                  WRITE(ID_TABOUT,*) ' '
                  WRITE(ID_TABOUT,*)' Maximum number of stages reached.'
                  WRITE(ID_TABOUT,*) ' RUN ABORTED '
                  WRITE(ID_TABOUT,*) ' '
C
                  STOP ' '
              ENDIF
C
C
      ELSEIF( JTYPES(ICRD) .EQ. 6 ) THEN
C
C             Card type 6: Ncards is the number of cards in the 
C             storage arrays.  Set this value.
C
              NCARDS = ICRD
C
C             Shift the data from the storing arrays into the 
C             working arrays.
C
              CALL WORK
C
C             The end of the initialization cards has been reached.  
C             Return and start the trajectory up to this point.
C
              RETURN
C
C
      ENDIF
C
C
C     Go read the next card in the input.
C
      GOTO 140 
C
C
C  Error handler for reading CADIN.ASC file.  Executable CADIN.ASC records are
C  in a specific format.  This error handler will allow full length records for 
C  record type 4 (comment cards).  If not card type 4, end program.
C
  900 IF( JTYPES(ICRD) .EQ. 4 ) THEN
          BACKSPACE ID_CADIN
          READ( ID_CADIN, 910, END=180 ) JTYPES(ICRD), COMMENT
  910     FORMAT( I2, A70 )
          GOTO 140
      ELSE
          BACKSPACE ID_CADIN
          READ( ID_CADIN, '(A)') CADIN_LINE
          WRITE(ID_TABOUT,*) ' '
          WRITE(ID_TABOUT,*) ' Error reading CADIN.ASC'
          WRITE(ID_TABOUT,920) 'record: ', TRIM(CADIN_LINE)
          WRITE(ID_TABOUT,*) ' '
          WRITE(ID_TABOUT,*) ' RUN ABORTED '
          WRITE(ID_TABOUT,*) ' '
C
          STOP ' '
  920     FORMAT(8X,A,1X,A)
      ENDIF
C
      END
      SUBROUTINE RDI1_7DATA( MODE, NSTAGE, EVALUE, V2 )
C
C-------------------------------------------------------------------------
C
C  Read the specialized type 7 cards.  Type 7 card  is the initialize 
C  vector card.  This module reads the special cards that follow the 
C  type 7 header card.   These cards contain the vector value in a 
C  list-directed format.  A maximum of 20 variables is imposed and 
C  a maximum of 10 cards may be entered.
C
C--Argument List Definitions--------------------------------------------
C
C  MODE   = (I) (+ or - ) and the number of elements in the array; 
C  NSTAGE = (I) The current stage number.
C  EVALUE = (R) if mode .lt. 0, theis value is the value all elements 
C               are to be set to.
C  V2     = (R) The returned value to be stored as the second real 
C           variable of the type 7 card.
C
C-------------------------------------------------------------------------
C
      COMMON /C7SVD/  IC7S0, C7S0(10,20), IC7SN(20), C7SN(20,5,20)
C      
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C 
      PARAMETER  ( MAXCS0 = 10,  MAXCSN= 5 ) 
C
      CHARACTER CADIN_LINE*80
C
C
C---  Check to make sure that the data arrays are not full.
C     If room in arrays, set V2 now so that it is not forgotten.
C
      IF( NSTAGE .EQ. 0 ) THEN
C
C         Test for storing data in stage 0 array
C
          IF( IC7S0 .GE. MAXCS0 ) THEN
C
C             Data arrays are full.  Give error messages
C
              WRITE(ID_TABOUT,*)
              WRITE(ID_TABOUT,*)
     1        ' *** MAXIMUM NUMBER TYPE 7 CARDS EXCEEDED '
              WRITE(ID_TABOUT,*) ' ***  IN STAGE 0 '
              WRITE(ID_TABOUT,*)
C
              STOP ' '
C
          ENDIF
C
          IC7S0 = IC7S0 + 1
C
C         Save this information in the header card.
C 
          V2 = IC7S0
C
      ELSE
C
C         Test for storing data in the stage array
C
          IF( IC7SN( NSTAGE ) .GE. MAXCSN ) THEN
C
C             Data arrays are full.  Give error messages
C
              WRITE(ID_TABOUT,*)
              WRITE(ID_TABOUT,*)
     1        ' *** MAXIMUM NUMBER TYPE 7 CARDS EXCEEDED '
              WRITE(ID_TABOUT,*) ' ***  IN STAGE: ', NSTAGE
              WRITE(ID_TABOUT,*)
C
              STOP ' '
          ENDIF
C
          IC7SN( NSTAGE ) = IC7SN( NSTAGE ) + 1
C
C         Save this information in the header card.
C 
          V2 = IC7SN( NSTAGE )
C
      ENDIF
C
C
C---  Determine which mode is being used to initialize the vector
C
      IF( MODE .LT. 0 ) THEN
C
C         Mode 0 : Initialize all elements to the same value.
C         Save the information to the array.  Even though this 
C         appears to be unnecessary, if this card is modified by
C         a group card, this allows the modification to be
C         properly performed.
C
          IF( NSTAGE .EQ. 0 ) THEN 
C
C             Stage 0 :
C
              C7S0( IC7S0, 1 ) = EVALUE
C
          ELSE
C
C             Stage N :
C
              C7SN( NSTAGE, IC7SN( NSTAGE ), 1 ) = EVALUE
C
          ENDIF
C
C         This mode has no following records.  All infomration
C         has been read and loaded into the proper arrays
C         so return from the module.
C
C
      ELSE
C
C         Mode N : Initialize all elements to individual values.
C         Read the indiviidual values:
C
          NELEMENTS = ABS( MODE )
C
          IF( NSTAGE .EQ. 0 ) THEN 
C
C             Stage 0 :
C
              READ(ID_CADIN,*,ERR=888,IOSTAT=IOSTAT) 
     1           ( C7S0(IC7S0,I), I=1, NELEMENTS )
C
          ELSE
C
C             Stage 1 :
C
              READ(ID_CADIN,*,ERR=888,IOSTAT=IOSTAT) 
     1           ( C7SN( NSTAGE, IC7SN( NSTAGE) , I ), I=1, NELEMENTS )
C
          ENDIF
      ENDIF
C
C
      GOTO 999
C
C
C---  Error message on the read statement
C
  888 CONTINUE
C
      WRITE( *, *) 
      WRITE( *, *) ' *** ERROR READING VALUES FROM TYPE 7 CARDS '
      WRITE( *, *) ' *** FOR STAGE ', NSTAGE
C
      IF(IOSTAT .NE. 0) THEN
          BACKSPACE ID_CADIN
          READ(ID_CADIN,'(A)') CADIN_LINE
          WRITE(ID_TABOUT,920) 'record: ', TRIM(CADIN_LINE)
          WRITE(ID_TABOUT,*) ' '
C
          STOP ' '
  920     FORMAT(6X,A,1X,A)
      ENDIF
C
C
  999 CONTINUE
C
C
      RETURN
      END
      SUBROUTINE RDI1_10CARD( NSTAGE, NTEST, INTDATA, CHRDATA, RELDATA )
C
C-------------------------------------------------------------------------
C
C  This module reads in the staging criteria that follows a type 10 card 
C  from the input data file.  This data is stored into arrays and the 
C  data is accessed later by other modules.
C  Card type = 10 : Read stage test(s), using C(N)
C
C  Format for card type 10 data:
C 
C  Record #   Column number   Data
C
C   1*         1 -  2         "10"
C              25             Number of Tests (Integer 1 or 2)
C                * Card 1 has been read prior to this module being called.
C   2          1 -  6         Name of staging variable (Character)
C              7 - 11         C Element Location of Variable (Integer)
C             12 - 16         Integer staging flag (Integer 0 or 1)
C             18 - 23         Used if KODE = 0 (Character)
C             24 - 38         Variable Value (Real)
C             40 - 45         Units ? (Not used in Executive) (Character)
C             46 - 50         Staging flag KODE (Integer)
C   3**          Identical to record 2; contains the staging criteria for 
C                the second staging test; mandatory when Ntest = 2
C
C  
C
C--Argument List Definitions--------------------------------------------
C
C  NSTAGE         - (I) I/O.  The stage number that the stage cards 
C                   apply to. This value is incremented within this module.
C  NTEST          - (I) Input.  The number of stage cards following the 
C                   type 10 card.  NOTE:  at least 1 stage card must 
C                   follow the type 10 card;  NTEST may be blank/zero 
C                   for this case.
C  INTDATA(20,2,4)  - (I) Output. Contains the integer data input on the 
C                   test criteria cards. ( Nstage, Ntest, Nth integer)
C  CHRDATA(20,2,2) - (C6) Output. Contains the character data input on 
C                   the test criteria cards. 
C                   (Nstage, Ntest, Nth Character data)
C  RELDATA(20,2)     - (R) Output. Contains the real data input on the 
C                   test criteria cards.  (Nstage, Ntest)
C
C-------------------------------------------------------------------------
C
      DIMENSION INTDATA(20,2,4), RELDATA(20,2)
      CHARACTER CHRDATA(20,2,2)*6, CADIN_LINE*80
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C
C     Card type 10 : Read in the staging criteria cards:
C
C     Increment the stage number:
C
      NSTAGE = NSTAGE + 1
C
C     Number of test cards following (1 or 2 ).  Will always be at 
C     least 1 stage card following the type 10 card, but LOCS may be 
C     blank/zero in this case.  Check for this.
C
      IF( NTEST .NE. 1  .AND.  NTEST .NE. 2 ) NTEST = 1
C
C     Read the stage cards:
C
      DO KTEST = 1, NTEST
         READ(ID_CADIN,360,IOSTAT=IOSTAT,ERR=900,END=400) 
     1                              CHRDATA(NSTAGE,KTEST,1), 
     2                            ( INTDATA(NSTAGE,KTEST,L), L=1,2 ),
     3                              CHRDATA(NSTAGE,KTEST,2), 
     4                              RELDATA(NSTAGE,KTEST),
     5                           ( INTDATA(NSTAGE,KTEST,L), L=3,4 )
  360    FORMAT( A6, 2I5, 1X, A6, E15.9, 1X, I6, I5)
C
C---     This format statment was modified under t9201, Jan 1991.  The 
C---     INTDATA(Nstage,Ktest,3) element was modified to be read as an 
C---     integer.  
C---     Reading character in the format, then changing to integer, placed a 
C---     value in the variable when the input string contained blanks (due to 
C---     hex value in variable?) This variable was assigned to the UNITS 
C---     array in OINPT2, but UNITS was not used in the other executive 
C---     modules or in the modules used for testing under this task.
C---     This is the original format statement: 
C---       360    FORMAT( A6, 2I5, 1X, A6, E15.9, 1X, A6, I5)
C
  400    CONTINUE
C        
         IF( INTDATA(NSTAGE,KTEST,1) .LT. 1     .OR. 
     1       INTDATA(NSTAGE,KTEST,1) .GT. 3510  ) THEN 
C
             WRITE(ID_TABOUT,*)
             WRITE(ID_TABOUT,*)
     1       ' *** INVALID C LOCATION IN STAGE CRITERIA ***'
             WRITE(ID_TABOUT,*)
C
             STOP ' '
         ENDIF
      ENDDO
C
C     Error handler for errors reading the CADIN.ASC input file.
C     The errors found here result in format erros with type 10 stage test cards, 
C     other than invalid C locations
C
  900 IF(IOSTAT .NE. 0) THEN  ! Error occurred during CADIN read
          BACKSPACE ID_CADIN
          READ(ID_CADIN, '(A)') CADIN_LINE
          WRITE(ID_TABOUT,*) ' '
          WRITE(ID_TABOUT,*) ' Error reading CADIN.ASC'
          WRITE(ID_TABOUT,920) 'record: ', TRIM(CADIN_LINE)
          WRITE(ID_TABOUT,*) ' '
          WRITE(ID_TABOUT,*) 'RUN ABORTED'
          WRITE(ID_TABOUT,*) ' '
C
          STOP ' '
  920     FORMAT(8X,A,1X,A)
      ENDIF
C
      RETURN
      END
      SUBROUTINE RDI1_16CARD( ISTAT, ICRD, NSTG  ) 
C
C-------------------------------------------------------------------------
C
C     Card Type = 16 :  Continue Simulation.  
C     This card signals that the following input cards are not to 
C     be used until a stage requirement (from a type 10 card ) is 
C     satisfied.  The cards following the type 16 card belong to the 
C     next stage.   An end of stage is determined by a card of type 
C     10 (the next stage), 6 (continue execution), 12 (next group).
C
C--Argument List Definitions--------------------------------------------
C
C  ISTAT - (I) Return status flag.  0 = continue reading from input.
C           1 = Type 6 card encountered; calculate trajectory.
C  ICRD  - (I) A card counter for the number of initialization cards 
C                 read from the input file (35)
C  NSTG  - (I) The number of stages found in the initialization card 
C                 deck.
C
C-------------------------------------------------------------------------
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /IPSAV/   NCARDS, NHOL, JTYPES(500), LOCS(500), MODS(500), 
     1                 VA1S(500), VA2S(500), MOD2(500)

      COMMON /IPSAVC/  ALS(3,500), HOLS(5)
      CHARACTER        ALS*6, HOLS*80
C
      COMMON /IPSVSC/  MCRIS(20,2,4), VALS(20,2)
C
      COMMON /IPSVSCC/ MCRISC(20,2,2)
      CHARACTER        MCRISC*6
C
      COMMON /IPSVST/  JTSTS(20,60), LOCSTS(20,60), MODSTS(20,60), 
     1                 VA1STS(20,60), VA2STS(20,60), MOD2ST(20,60),
     2                 NCD(20)
C
      COMMON /IPSVSTC/ ALSTS(20,3,60)
      CHARACTER        ALSTS*6
C
      CHARACTER COMMENT*80, CADIN_LINE*80
C
      DATA MAXSTAGE/ 20 /, MAXSTCARD / 60 /
C
C
C
      ISTAT = 0
C
C---  Initialize Counter for the number of cards in this stage.
      NN = 1   
C
C
  100 CONTINUE
C
C---  Read the card data for the stages into a stage array.
C---  (ie JType for STageing Storage array. )
      READ(ID_CADIN,160,END=220,ERR=900) JTSTS(NSTG,NN), 
     1        ( ALSTS(NSTG,L,NN), L=1,3), LOCSTS(NSTG,NN), 
     2        MODSTS(NSTG,NN), VA1STS(NSTG,NN), 
     3        VA2STS(NSTG,NN), MOD2ST(NSTG,NN)
  160 FORMAT( I2, 3A6, 2I5, 2E15.9, I2 )
  220 CONTINUE
C
C
      IF( JTSTS(NSTG,NN) .EQ. 6  .OR.  JTSTS(NSTG,NN) .EQ. 10  
     1    .OR.  JTSTS(NSTG,NN) .EQ. 12 ) THEN
C
C---      Card type 6, 12 or 10 found following a type 16 card.
C---      The card type 6,12,10 is not a part of the stage cards so
C---      correct the stage card counter and save this value into 
C---      the proper array.
          NCD( NSTG ) = NN - 1
C
          IF( JTSTS(NSTG,NN) .NE. 12 ) THEN 
C
C---          Card type 6 or 10.  This card is not apart of the 
C---          stage card set so load the data from this card 
C---          into the appropriate arrays.  
C---          (ie same arrays from previous loop)
              ICRD = ICRD + 1               ! Increment card counter.
C
C---          Transfer the data.
              JTYPES(ICRD) = JTSTS(NSTG,NN)
C
              DO K = 1, 3
                 ALS(K,ICRD) = ALSTS(NSTG,K,NN)
              ENDDO
C
              LOCS(ICRD) = LOCSTS(NSTG,NN)
              MODS(ICRD) = MODSTS(NSTG,NN)
              VA1S(ICRD) = VA1STS(NSTG,NN)
              VA2S(ICRD) = VA2STS(NSTG,NN)
              MOD2(ICRD) = MOD2ST(NSTG,NN)
C
              IF( JTYPES(ICRD) .EQ. 10 ) THEN
C
C---              Card type 10: read the data for this card type 
                  CALL RDI1_10CARD( NSTG, LOCS(ICRD), MCRIS, MCRISC,
     1                                  VALS )
C
                  IF(  NSTG .GT. MAXSTAGE ) THEN 
                       WRITE(ID_TABOUT,*) ' '
                       WRITE(ID_TABOUT,*) 
     1                          ' Maximum number of stages reached. '
                       WRITE(ID_TABOUT,*) ' RUN ABORTED '
                       WRITE(ID_TABOUT,*) ' '
C
                       STOP ' '
                  ENDIF
C
C---              Continue the input process. 
                  ISTAT = 0
C
                  RETURN
C
C
              ELSE
C
C---              Card type 6: process like the card type 12.
C
C---              Ncards is the number of cards in the storage arrays.  
C---              Set this value.C
                  NCARDS = ICRD
C
C---              Shift the data from the storing arrays into the 
C---              working arrays.
                  CALL WORK
C
C---              The end of the initialization cards has been reached.  
C---              Return and start the trajectory up to this point.
                  ISTAT = 1
C
                  RETURN
C
              ENDIF
C
          ELSE
C
C---          Card type 12 
C---          Ncards is the number of cards in the storage arrays.  
C---          Set this value.  Type 12 card : don't include this card 
C---          in the storage deck.
              NCARDS = ICRD - 1
C
C---          Shift the data from the storing arrays into the 
C---          working arrays.
              CALL WORK
C
C---          The end of the initialization cards has been reached.  
C---          Return and start the trajectory up to this point.
              ISTAT = 2
C
              RETURN
C
          ENDIF
C
      ENDIF 
C
C---  Card type is other than 10,12,6 :
C---  Increment card counter for this stage.  Check for out of array 
C---  bounds.
      IF( JTSTS(NSTG,NN) .EQ. 7 ) THEN 
C
C---      Card type 7 was entered.  Read the data from the file
C---      and load it into the proper arrays.
          CALL RDI1_7DATA( MODSTS(NSTG,NN), NSTG, VA1STS(NSTG,NN), 
     1                      VA2STS(NSTG,NN) )
C
      ENDIF 
C
C
      NN = NN + 1
C
      IF( NN .GT. MAXSTCARD ) THEN 
        WRITE(ID_TABOUT,*) ' '
        WRITE(ID_TABOUT,*)' Maximum number of stage input cards reached'
        WRITE(ID_TABOUT,*) ' RUN ABORTED '
        WRITE(ID_TABOUT,*) ' '
C
        STOP ' '
      ENDIF
C
C     Go read the next record of data.
C
      GOTO 100 
C
C  Error handler for reading CADIN.ASC file.  Executable CADIN.ASC records are
C  in a specific format.  This error handler will allow full length records for 
C  record type 4 (comment cards).  If not card type 4, end program.
C
  900 IF( JTSTS(NSTG,NN) .EQ. 4 ) THEN
          BACKSPACE ID_CADIN
          READ( ID_CADIN, 910, END=220 ) JTSTS(NSTG,NN), COMMENT
  910     FORMAT( I2, A70 )
          GOTO 100
      ELSE
          BACKSPACE ID_CADIN
          READ( ID_CADIN, '(A)') CADIN_LINE
          WRITE(ID_TABOUT,*) ' '
          WRITE(ID_TABOUT,*) ' Error reading CADIN.ASC'
          WRITE(ID_TABOUT,920) 'record: ', TRIM(CADIN_LINE)
          WRITE(ID_TABOUT,*) ' '
          WRITE(ID_TABOUT,*) ' RUN ABORTED '
          WRITE(ID_TABOUT,*) ' '
C
          STOP ' '
  920     FORMAT(8X,A,1X,A)
      ENDIF
C
      END
C
      SUBROUTINE RDI1_ATMOSPHR( NWX, WXS )
C
C-------------------------------------------------------------------------
C
C   This module reads in the atmospheric data that follows a type 8 
C   card.
C
C--Argument List Definitions--------------------------------------------
C
C  NWX       - (I) The number of atmospheric data sets read into the 
C              WXS array.  
C  WXS(6,50) - (R) Output. Contains the atmospheric data as read from the 
C              input cards.  WXS(I,J) :
C              I => 1 = Altitude, 2 = Wind Direction, 3 = Wind 
C                 Velocity, 4 = Density, 5 = Temnperature, 6 = Pressure
C              Up to J=50 sets of atmospheric data may be entered.
C
C-------------------------------------------------------------------------
C
      DIMENSION WXS(6,50) 
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      CHARACTER CADIN_LINE*80
C
C     Read in the atmospheric data:
C
      K = 0     ! Initialize the array counter.
C
  240 CONTINUE
      K = K + 1
C
C     Read the data from the input file
C
      READ(ID_CADIN,*,END=260,IOSTAT=IOSTAT,ERR=900) ( WXS(M,K), M=1,6 )
  260 CONTINUE
C
C     If the altitude is greater than 0.0, go read the next 
C     record - End of weather is indicated by a negative altitude.
C         
      IF( WXS(1,K) .GE. 0.0 ) GOTO 240
C
C     End of atmospheric data reached.  Adjust data counter.
C
      NWX = K - 1
C
C     Error handler for errors reading the CADIN.ASC input file
C     The errors found here result in format errors within the weather input records.
C     Type 4 (comment) records are allowed with the weather records only following
C     the correct format for comments (i.e. columns 1 and 2 must contain '04' followed
C     by the full length comment.  All other records between weather records are not
C     allowed.
C
  900 IF(IOSTAT .NE. 0) THEN  ! Error encountered during weather data read
          BACKSPACE ID_CADIN
          READ(ID_CADIN,'(A)') CADIN_LINE
          IF( CADIN_LINE(1:2) .EQ. '04') THEN ! Comment record within weather data
              K=K-1 ! Reset the weather data counter
              GOTO 240
          ELSE    ! Error reading weather data
              WRITE(ID_TABOUT,*) ' '
              WRITE(ID_TABOUT,*) ' Error reading CADIN.ASC'
              WRITE(ID_TABOUT,920) 'record: ', TRIM(CADIN_LINE)
              WRITE(ID_TABOUT,*) ' '
              WRITE(ID_TABOUT,*) 'RUN ABORTED'
              WRITE(ID_TABOUT,*) ' '
C
              STOP ' '
  920         FORMAT(8X,A,1X,A)
          ENDIF
      ENDIF
              
C
      RETURN
      END
      SUBROUTINE RDI2_GROUP( FLAG13 )
C
C-------------------------------------------------------------------------
C
C  This module copies the primary trajectory data to the working 
C  arrays; performs reads to the input file (unit 35) and acquires 
C  the group data; then modifies the primary trajectory data or adds the 
C  unique card to the set.
C
C--Argument List Definitions--------------------------------------------
C
C  FLAG13 - (L) Indicates if a card type 13 was found in the input.
C
C--Local Variable Definitions-------------------------------------------
C
C  NTEST - (I) Number of test cards following a type 10 card: Either 1 
C          or 2.  There must be at least 1 stage card following the type 
C          10 card but NTEST may be blank/zero for this case.
C
C-------------------------------------------------------------------------
C
      COMMON /WSET/    NCARD, JTYPE(500), LOCA(500), MOE(500), 
     1                 VA1(500), VA2(500), M2(500)
C
      COMMON /WSETC/   AL(3,500), HOLL(5)
      CHARACTER        AL*6, HOLL*80
C
      COMMON /NAD/     IBEEN, IBEGIN, ICARD, ISAVE
C
C
      LOGICAL FLAG13
C
C
C     The initial read from the lead card deck has already been 
C     performed until a type 6/12 card was reached.  After a type 
C     6/12 card, the trajectory calculations start over.  Reload the 
C     base trajectory into the working arrays and modify them with 
C     the cards from the next group.
C 
C---  Copy the saved primary trajectory cards into the working arrays.
      CALL WORK
C
C
C---  Read the group cards.
      CALL RDI2_RDCARD( FLAG13 ) 
C
C
      RETURN
      END
      SUBROUTINE RDI2_7GCREAD( IPOS, MODE, NSTAGE, EVALUE, V2 )
C
C-------------------------------------------------------------------------
C
C  Read the specialized type 7 cards entered as a part of the group 
C  cards.  Type 7 card is the initialize 
C  vector card.  This module reads the special cards that follow the 
C  type 7 header card.   These cards contain the vector value in a 
C  list-directed format.  A maximum of 20 variables is imposed and 
C  a maximum of 10 cards may be entered.
C
C--Argument List Definitions--------------------------------------------
C
C  IPOS   = (I) The position in the arrays where the data is to be 
C           stored.
C  MODE   = (I) The number of elements in the array as either a + or - 
C           value to select the initialization mode.  A - value initializes 
C           all vector elements to the same value of V1;  A + value 
C           initializes the vector elements to individual points.  
C  NSTAGE = (I) The current stage number.
C  EVALUE = (R) For MODE < 0 : the value all elements are to be set to.
C  V2     = (R) The returned value to be stored as the second real 
C           variable of the type 7 card.
C
C-------------------------------------------------------------------------
C
      COMMON /C7WKD/   IWC7S0, WC7S0(10,20), IWC7SN(20), WC7SN(20,5,20)
C 
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      PARAMETER  ( MAXCS0 = 10,  MAXCSN= 5 ) 
C
      CHARACTER CADIN_LINE*80
C
C
C      IF( NSTAGE .NE. 0 ) THEN 
C
C---      Check to make sure that the data arrays are not full.
C         If room in arrays, set V2 now so that it is not forgotten.
C
C         Test for storing data in the stage array
C
C          IF( IC7SN( NSTAGE ) .GE. MAXCSN ) THEN
C
C             Data arrays are full.  Give error messages
C
C              WRITE(ID_TABOUT,*)
C              WRITE(ID_TABOUT,*) ' *** MAXIMUM NUMBER TYPE 7 CARDS EXCEEDED '
C              WRITE(ID_TABOUT,*) ' ***  IN STAGE: ', NSTAGE
C              WRITE(ID_TABOUT,*)
C
C              STOP ' '
C          ENDIF
C
C          IC7SN( NSTAGE ) = IC7SN( NSTAGE ) + 1
C
C         Save this information in the header card.
C      ENDIF
C
C
      V2 = IPOS 
C
C
C---  Determine which mode is being used to initialize the vector
C
C
      IF( MODE .LT. 0 ) THEN
C
C         Mode < 0 : Initialize all elements to the same value.
C         Save the information to the array.  Even though this 
C         appears to be unnecessary, if this card is modified by
C         a group card, this allows the modification to be
C         properly performed.
C
          IF( NSTAGE .EQ. 0 ) THEN 
C
C             Stage 0 :
C
              WC7S0( IPOS, 1 ) = EVALUE
C
          ELSE
C
C             Stage N :
C
              WC7SN( NSTAGE, IPOS, 1 ) = EVALUE
C
          ENDIF
C
C---      This mode has no following records.  All infomration
C---      has been read and loaded into the proper arrays
C---      so return from the module.
C
C
      ELSE
C
C---      Mode > 0 : Initialize all elements to individual values.
C---      Read the indiviidual values:
C
          IF( NSTAGE .EQ. 0 ) THEN 
C
C             Stage 0 :
C
              READ(ID_CADIN,*,ERR=888,IOSTAT=IOSTAT) 
     1           ( WC7S0( IPOS, I ), I=1, MODE )
C
          ELSE
C
C             Stage 1 :
C
              READ(ID_CADIN,*,ERR=888,IOSTAT=IOSTAT) 
     1           ( WC7SN( NSTAGE, IPOS, I ), I=1, MODE )
C
          ENDIF
      ENDIF
C
C
      GOTO 999
C
C
C---  Error message on the read statement
C
  888 CONTINUE
C
      WRITE( *, *) 
      WRITE( *, *) ' *** ERROR READING VALUES FROM TYPE 7 CARDS '
      WRITE( *, *) ' *** FOR STAGE ', NSTAGE
      WRITE( *, *) 
C
      IF(IOSTAT .NE. 0) THEN
          BACKSPACE ID_CADIN
          READ(ID_CADIN,'(A)') CADIN_LINE
          WRITE(ID_TABOUT,920) 'record: ', TRIM(CADIN_LINE)
          WRITE(ID_TABOUT,*) ' '
C
          STOP ' '
  920     FORMAT(6X,A,1X,A)
      ENDIF
C
C
  999 CONTINUE
C
C
      RETURN
      END
      SUBROUTINE RDI2_RDCARD( FLAG13 )
C
C-------------------------------------------------------------------------
C
C This module reads the group cards from the lead card deck.  This read 
C is performed after the primary trajectory has been calculated.  The 
C primary trajectory cards are copies into the working arrays;  the group 
C cards are read from the lead card deck and inserted/added/modify the 
C primary trajectory cards accordingly.
C
C--Argument Definitions-------------------------------------------------
C
C  FLAG13 - (L) Flag that indicates whether a card type 13 was detected 
C           or not.
C
C--Local Variable Definitions-------------------------------------------
C
C  JJ - (I) The card type of the new card being added. 
C
C  The following data is read from the lead card deck and the 
C  exact variable definitions are dependant on the card type:
C  A1 - (C6) The first character data read from the lead card deck. 
C  A2 - (C6) The second character data read from the lead card deck. 
C  A3 - (C6) The third character data read from the lead card deck. 
C  KKARD - (I) Counter that counts the number of cards read for each 
C          group.
C  LO - (I)  The first integer data read from the lead card deck.
C       Usually the location to be modified/defined by the input card.
C  MO - (I) The second integer data read from the lead card deck.
C  V1 - (R) The first real data read from the lead card deck.
C  V2 - (R) The second read data read from the lead card deck.
C  M1 - (I) The fourth integer data read form the lead card deck.
C  COMMENT - Type 4 card comment record
C  CADIN_LINE - Error record within ID_CADIN
C
C-----------------------------------------------------------------------
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      CHARACTER  A1*6, A2*6, A3*6
      LOGICAL    FLAG13
C
      CHARACTER COMMENT*80, CADIN_LINE*80
C
      FLAG13 = .FALSE. 
      KKARD  = 0
C
C
  100 CONTINUE
C
C---  Read a group card from the lead card deck.  (JJ = card type.)
      READ(ID_CADIN,160,END=3000,ERR=900) JJ, A1, A2, A3 ,LO, 
     1                                    MO, V1, V2, ISTG
  160 FORMAT( I2, 3A6, 2I5, 2E15.9, I2 )
C
      KKARD = KKARD + 1
C
      IF( JJ .EQ. 13 ) THEN
C
C         Card type 13 = end of inputs; finish the trajectory.
C
          FLAG13 = .TRUE. 
          RETURN
C
      ELSEIF( JJ .EQ. 4 ) THEN
C
C         Card type 4 = comment card for input deck.  Ignore this
C         card type/data.  Go read another card.
C
          GOTO 100
C
      ELSEIF( JJ .EQ. 12 ) THEN
C
C         End of group signaled.
C
          IF( KKARD .LT. 2 ) THEN
C 
C             No cards were entered between this type 12 card and the
C             previous type 6/12 card.  Don't return - Read the next 
C             group of cards.
C
              KKARD  = 0
              GOTO 100
C
          ELSE
C
C             Go process this group of cards.
C
              RETURN 
C
          ENDIF
C
      ENDIF
C
C
C     Check the stage flag to see if this card mod/add applies to a 
C     particular stage in the lead card set.
C
      IF( ISTG .LT. 1 ) THEN
C
C         This card is a mod/add to stage 0 - the cards prior to any 
C         stages.  Search the stage for a matching card and update it 
C         or if none found, add this card to this stage.
C
          CALL RDI2_ST0SEARCH( JJ, A1, A2, A3, LO, MO, V1, V2 )
C
      ELSE
C
C         This card is a mod/add to a particular stage.  Search 
C         the stage for a matching card and update it or if none found, 
C         add this card to this stage.
C
          CALL RDI2_STNSEARCH( ISTG, JJ, A1, A2, A3, LO, MO, V1, V2 )
C
      ENDIF
C
C
C---  Go read the next lead card.
      GOTO 100
C
C  Error handler for reading CADIN.ASC file.  Executable CADIN.ASC records are
C  in a specific format.  This error handler will allow full length records for 
C  record type 4 (comment cards).  If not card type 4, end program.
C
  900 IF( JJ .EQ. 4 ) THEN
          BACKSPACE ID_CADIN
          READ( ID_CADIN, 910, END=3000 ) JJ, COMMENT
  910     FORMAT( I2, A70 )
          GOTO 100
      ELSE
          BACKSPACE ID_CADIN
          READ( ID_CADIN, '(A)') CADIN_LINE
          WRITE(ID_TABOUT,*) ' '
          WRITE(ID_TABOUT,*) ' Error reading CADIN.ASC'
          WRITE(ID_TABOUT,920) 'record: ', TRIM(CADIN_LINE)
          WRITE(ID_TABOUT,*) ' '
          WRITE(ID_TABOUT,*) ' RUN ABORTED '
          WRITE(ID_TABOUT,*) ' '
C
          STOP ' '
  920     FORMAT(8X,A,1X,A)
      ENDIF
C
 3000 CONTINUE
C
C---  Read statment end label = End of input card deck.
      STOP ' '
C
      END
      SUBROUTINE RDI2_ST0SEARCH( JJ, A1, A2, A3, LO, MO, V1, V2 )
C
C-------------------------------------------------------------------------
C
C  This module searches the working card set for a card that matches
C  this current input card (card type and variable).  If no match is 
C  found, an error message is displayed inthe output. If a match 
C  is found, the new data is written over the old.  A special case is 
C  considered when the card type is 9.  When this card type matches, the 
C  variable is inappropriate for the type and ignored.
C
C--Argument Definitions-------------------------------------------------
C
C  JJ - (I) The card type of the new card being added. 
C  The following data is read from the lead card deck and the 
C  exact variable definitions are dependant on the card type:
C  A1 - (C6) The first character data read from the lead card deck. 
C  A2 - (C6) The second character data read from the lead card deck. 
C  A3 - (C6) The third character data read from the lead card deck. 
C  LO - (I)  The first integer data read from the lead card deck.
C       Usually the location to be modified/defined by the input card.
C  MO - (I) The second integer data read from the lead card deck.
C  V1 - (R) The first real data read from the lead card deck.
C  V2 - (R) The second real data read from the lead card deck.
C  M1 - (I) The fourth integer data read from the lead card deck = 
C       The stage number this card modifies/adds = stage 0
C
C--Local Variable Definitions-------------------------------------------
C
C JCARD  - (I) Counter for the number of cards in the working card deck.
C Saving arrays for swapping card locations:
C
C-------------------------------------------------------------------------
C
      CHARACTER  A1*6, A2*6, A3*6
C
C
      COMMON /C7WKD/   IWC7S0, WC7S0(10,20), IWC7SN(20), WC7SN(20,5,20)
C 
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /WSET/    NCARD, JTYPE(500), LOCA(500), MOE(500), 
     1                 VA1(500), VA2(500), M2(500)
C
      COMMON /WSETC/   AL(3,500), HOLL(5)
      CHARACTER        AL*6, HOLL*80
C
C
C
C     Initialize a variable to pass into a module
C
      ISTAGE = 0
C
C     Initialize card counter: 
C
      JCARD = 1
C
C
  100 CONTINUE
C
C
      IF( JJ .EQ. JTYPE(JCARD) .AND.  JJ .EQ. 9 ) THEN
C
C---    Found a matching card type 9 : Read following header cards.
        READ(ID_CADIN,'(A80)',END=620) (HOLL(K),K=1,LO)
  620   CONTINUE
C
C---    Update the working set with this data.
        JTYPE(JCARD) = JJ
        AL(1,JCARD) = A1
        AL(2,JCARD) = A2
        AL(3,JCARD) = A3
        LOCA(JCARD) = LO
        MOE(JCARD) = MO
        VA1(JCARD) = V1
        VA2(JCARD) = V2
        M2( JCARD) = 0
C
C
      ELSEIF( JJ .EQ. JTYPE(JCARD) .AND.  LO .EQ. LOCA(JCARD) ) THEN
C
C---    The card is a match - it modifies the same variable in
C---    the same card type.  Update the working card set.
C
C
C---    If the card is a type 7 card, save the position of thedata.
        IF( JJ .EQ. 7 ) IPOS = VA2( JCARD )
C
C---    Load the new data over the old positions.
        JTYPE(JCARD) = JJ
        AL(1,JCARD) = A1
        AL(2,JCARD) = A2
        AL(3,JCARD) = A3
        LOCA(JCARD) = LO
        MOE(JCARD) = MO
        VA1(JCARD) = V1
        VA2(JCARD) = V2
        M2( JCARD) = 0
C
C
C---    If the card is a type 7, finish reading the data and apply
C---    the modifications to the working arrays.
        IF( JJ .EQ. 7 ) 
     1  CALL RDI2_7GCREAD( IPOS, MO, ISTAGE, V1, VA2(JCARD) )
C     
C
      ELSE
C
C---    The card type does not match the JCARDth card in the working set.
C---    Increment JCARD.  
        JCARD = JCARD + 1
C
        IF( JCARD .GT. NCARD ) THEN 
C
C---       Have checked all the cards in the working set and a 
C---       match was not found.  
           WRITE(ID_TABOUT,*) 
           WRITE(ID_TABOUT,*) ' Group card match NOT found in initial'
           WRITE(ID_TABOUT,*) ' trajectory card set : '
           WRITE(ID_TABOUT,650) JJ, A1,A2,A3, LO,MO, V1,V2
  650      FORMAT( 1X, I2, 3A6, 2( I5, 1X ), 2( E15.9, 1X ) )
           WRITE(ID_TABOUT,*) 
C
        ELSE
C
C---      Go check the next card in the initialization card set.
          GOTO 100
C
        ENDIF
C
      ENDIF
C
C---  Go read the next card from the input deck.
C
      RETURN
      END
      SUBROUTINE RDI2_STNSEARCH( ISTG, JJ, A1,A2, A3, LO, MO, V1, V2 )
C
C-------------------------------------------------------------------------
C
C  This module searches the working card deck for a card that matches
C  this current input card ( card type and variable).  If no match is 
C  found, the card is added to the initialization card deck.  If a match 
C  is found, the new data is written over the old.  NOTE: as can be 
C  verified by the logic in RDIN_INIT, the stage card arrays will never
C  contain a type 10, 12 or 6 card;  therefore any additional cards
C  may simply be appended to the end of the deck for that stage.
C
C--Argument Definitions-------------------------------------------------
C
C  ISTG - (I) The stage number where the current input card is to be 
C         place = The fourth integer data read from the lead card deck.
C  JJ   - (I) The card type of the new card being added. 
C  The following data is read from the lead card deck and the 
C  exact variable definitions are dependant on the card type:
C  A1   - (C6) The first character data read from the lead card deck. 
C  A2   - (C6) The second character data read from the lead card deck. 
C  A3   - (C6) The third character data read from the lead card deck. 
C  LO   - (I)  The first integer data read from the lead card deck.
C         Usually the location to be modified/defined by the input card.
C  MO   - (I) The second integer data read from the lead card deck.
C  V1   - (R) The first real data read from the lead card deck.
C  V2   - (R) The second real data read from the lead card deck.
C
C--Local Variable Definitions-------------------------------------------
C
C  KNCARD - (I) The number of cards in the selected stage. 
C  JCARD  - (I) Counter for counting through the stage cards.
C
C-------------------------------------------------------------------------
C
      CHARACTER  A1*6, A2*6, A3*6
C
      COMMON /C7WKD/  IWC7S0, WC7S0(10,20), IWC7SN(20), WC7SN(20,5,20)
C 
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /WSETST/  NCDW(20), JTST(20,60), LOCST(20,60), 
     1                 MODST(20,60), VA1ST(20,60), VA2ST(20,60), 
     2                 M2ST(20,60)
C
      COMMON /WSETSTC/ ALST(20,3,60)
      CHARACTER        ALST*6
C
      PARAMETER  ( MAXCSN= 5 ) 
C
C  
      DATA MAXSTCARD/ 60 /
C
C
      KNCARD = NCDW( ISTG )
C
      IF( KNCARD .GT. 0 ) THEN
C
        JCARD = 1
C
  100   CONTINUE
C
        IF(  JJ .EQ. JTST(ISTG,JCARD) .AND.  
     1       LO .EQ. LOCST(ISTG,JCARD)        ) THEN 
C
C---      The card type and variable matches.  Update the card.
C
C
C---      If the card is a type 7 card, save the position of thedata.
C
          IF( JJ .EQ. 7 ) IPOS = VA2ST( ISTG, JCARD )
C
          JTST(ISTG,JCARD)   = JJ
          LOCST(ISTG,JCARD)  = LO
          MODST(ISTG,JCARD)  = MO
          M2ST( ISTG,JCARD)  = ISTG
          VA1ST(ISTG,JCARD)  = V1
          VA2ST(ISTG,JCARD)  = V2
          ALST(ISTG,1,JCARD) = A1
          ALST(ISTG,2,JCARD) = A2
          ALST(ISTG,3,JCARD) = A3
C
C---      If the card is a type 7, finish reading the data and apply
C---      the modifications to the working arrays.
          IF( JJ .EQ. 7 ) 
     1        CALL RDI2_7GCREAD( IPOS,MO, ISTG, V1, VA2ST(ISTG,JCARD))
C     
C---      Go read next card from the lead card deck.
          RETURN 
C          
        ENDIF
C
C---    No match found - increment counter.
        JCARD = JCARD + 1
C
C---    If not reached the end of the cards - check the next card.
        IF( JCARD .LE. KNCARD ) GOTO 100
C
      ENDIF
C
C  
C---  Either no cards in the stage, or no match in the cards.  Add the 
C---  current input card to the stage cards.
      IF( NCDW(ISTG) .LT. MAXSTCARD ) THEN 
C
        IF( JJ .EQ. 7 ) THEN 
C
          IF( IWC7SN( ISTG )  .LT. MAXCSN ) THEN 
C
C---        Add the data to the working arrays.
            NCDW(ISTG) = NCDW(ISTG) + 1
C
            JTST(ISTG,JCARD)   = JJ
            LOCST(ISTG,JCARD)  = LO
            MODST(ISTG,JCARD)  = MO
            M2ST( ISTG,JCARD)  = ISTG
            VA1ST(ISTG,JCARD)  = V1
            VA2ST(ISTG,JCARD)  = V2
            ALST(ISTG,1,JCARD) = A1
            ALST(ISTG,2,JCARD) = A2
            ALST(ISTG,3,JCARD) = A3
C
            IWC7SN( ISTG ) = IWC7SN( ISTG ) + 1
C
            CALL RDI2_7GCREAD( IWC7SN(ISTG), MO, ISTG, V1, 
     1                         VA2ST(ISTG,JCARD) )
         
          ELSE
C
            WRITE(ID_TABOUT,*) ' '
            WRITE(ID_TABOUT,*) ' Maximum number of initialization cards'
            WRITE(ID_TABOUT,*) ' reached while reading group. '
            WRITE(ID_TABOUT,*) ' RUN ABORTED '
            WRITE(ID_TABOUT,*) ' '
C
            STOP ' '
          ENDIF
C
        ELSE
C
C---      Add this card to the end of the deck.
          NCDW(ISTG) = NCDW(ISTG) + 1
C
          JTST(ISTG,JCARD)   = JJ
          LOCST(ISTG,JCARD)  = LO
          MODST(ISTG,JCARD)  = MO
          M2ST( ISTG,JCARD)  = ISTG
          VA1ST(ISTG,JCARD)  = V1
          VA2ST(ISTG,JCARD)  = V2
          ALST(ISTG,1,JCARD) = A1
          ALST(ISTG,2,JCARD) = A2
          ALST(ISTG,3,JCARD) = A3
        ENDIF
C
C
      ELSE
C
C---    The maximum number of stage cards has been reached.  
C---    Write an error message and stop.
C
        WRITE(ID_TABOUT,*) ' '
        WRITE(ID_TABOUT,*) ' Maximum number of initialization cards '
        WRITE(ID_TABOUT,*) ' reached while reading group. '
        WRITE(ID_TABOUT,*) ' RUN ABORTED '
        WRITE(ID_TABOUT,*) ' '
C
        STOP ' '
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE RD_TAPE90
C
C-------------------------------------------------------------------------
C  
C  This module loads data from tape 90 into the C array and sets the 
C  appropriate flags.
C
C-------------------------------------------------------------------------
C
      COMMON        C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /KRUN/    JRUN, MULRUN, IGROUP
C
      COMMON /NAD/     IBEEN, IBEGIN, ICARD, ISAVE
C
      COMMON /OINDAT/  J16, ICD, I16
C
      COMMON /PREV/    TPREV, CPPREV, PPPREV
C
      COMMON /STAGE1/  ISTAGE, NUMSTAGE
C
C
      DIMENSION   IC(3510)
C
      EQUIVALENCE (C(0001), IC(0001) )
      EQUIVALENCE (C(2000), TIME  )
C
C
C     Restore the stage number and card number for when the save 
C     occurred.
C
      NUMSTAGE = IBEGIN
      ICD = ICARD
C
C
      J16 = 1
      I16 = 1
C
C
      OPEN( ID_CSAVE, FILE='CSAVE.ASC', STATUS='OLD' )
C
      REWIND ( ID_CSAVE )
      READ(ID_CSAVE, *)  C, IC
C
C--------------------------------------------------------------------
C
      CLOSE( ID_CSAVE )
C
C---  End routine loaded inline.
      TPREV  = TIME
C
C
      RETURN
      END
      SUBROUTINE OP3_RTIWRITE
C
C----------------------------------------------------------------------
C
C  This subroutine prints the necessary acronyms and data to the Real-
C  Time CADAC initialization data file.
C
C----------------------------------------------------------------------
C
      DIMENSION PLOTDATA(70), IC(3510)
C
      COMMON C(3510)
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /OPINIT/  IPLINIT(70), INTPINIT(70), NINITVAR
      LOGICAL          INTPINIT
C
      COMMON /OPINITC/ INITLAB
      CHARACTER        INITLAB(70)*8
C
      EQUIVALENCE (C(0001), IC(0001))
C
      IPLINIT(1) = 2000    
C
C---  Determine the data to print to the TRAJ.* files.
      DO I = 1, NINITVAR 
         IF( INTPINIT(I) ) THEN
             PLOTDATA(I) = IC( IPLINIT(I) ) 
         ELSE
             PLOTDATA(I) = C( IPLINIT(I) )
         ENDIF
      ENDDO
C   
      IF( INITBIN ) THEN
          WRITE(ID_INITBIN)   ( PLOTDATA(I), I=1,NINITVAR )  
          CLOSE( ID_INITBIN )
      ENDIF
      IF( INITASC ) THEN
          WRITE(ID_INITASC,*) ( PLOTDATA(I), I=1,NINITVAR )
          CLOSE( ID_INITASC )
      ENDIF
C
      RETURN
      END
      SUBROUTINE SAV_INSTREAM 
C
C----------------------------------------------------------------------
C
C   Copy the input cards (unit 35) to the output file/display
C
C--Local Variable Definitions-------------------------------------------
C
C  HEADCARD - (C80) A character string used to read in the input title 
C             and any header card data 
C
C----------------------------------------------------------------------
C
      PARAMETER ( MAXTESTS = 2 )
C
      DIMENSION WDATA(6), VALUES(20)
      CHARACTER A1*6, A2*6, A3*6, HEADCARD*80, COMMENT*80, CADIN_LINE*80
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C---  Rewind the input file.
      REWIND (ID_CADIN)
C
C---  Start the input display at the top of page.
      WRITE(ID_TABOUT,50)
  50  FORMAT('1')
C
C---  Read the title.
      READ(ID_CADIN, '(A)' ) HEADCARD
      WRITE(ID_TABOUT, * ) HEADCARD
C
C---  Read the input cards:
C
C---  Loop: read the input card and write the card to output.  Continue 
C---  until the end of file on input is reached.
   70 CONTINUE
C
      READ(ID_CADIN,90,END=110,ERR=900) I1, A1, A2, A3, I2
     1                                  I3, R1, R2, I4 
   90 FORMAT( I2, 3A6, 2I5, 2E15.9, I2 )
C       
      WRITE(ID_TABOUT, 100 ) I1, A1,A2,A3, I2,I3, R1,R2, I4 
  100 FORMAT( 1X, I4, 1X, 3A6, 1X, I6, 1X, I10, 1X, G15.5, 1X, G15.5, 
     1          1X, I3 )
C
C
      IF( I1 .EQ. 7 ) THEN 
C
C         Read the vector assignment cards : IF MODE > 0 then the
C         elements are assigned individual values which are input in
C         a free-field format on following cards.  IF MODE < 0, 
C         no extra cards follow the type 7 card; this format is all 
C         contained on this line.
C
          IF( I3 .GT. 0  ) THEN 
C
              IF( I3 .LT. 21 ) THEN 
                READ(ID_CADIN,*) ( VALUES( NUM ), NUM = 1, I3 )
                WRITE(ID_TABOUT, *) ( VALUES( NUM ), NUM = 1, I3 )
              ELSE
                WRITE(ID_TABOUT,*) 
     1            ' *** ERROR - TOO MANY ELEMENTS IN TYPE 7 CARD *** '
              ENDIF
C
          ENDIF
C
      ELSEIF( I1 .EQ. 8 ) THEN
C
C---      Read the weather deck cards which are in a different format.
C---      The weather data is list directed format having 6 values per
C---      record.  The first value is altitude.  A record with a 
C---      negative altitude ( ie -1.0 or less ) signifies the end of 
C---      data.
C
C
  104     CONTINUE
C
          READ(ID_CADIN,*) ( WDATA(I), I=1,6 )
C
          IF( WDATA(1) .GT. -1.0 ) GOTO 104
C
C
      ELSEIF( I1 .EQ. 9 ) THEN
C
C         Read the header cards which are in a different format.
C
          NUMCARDS = I2
          DO I = 1, NUMCARDS
             READ(ID_CADIN, '(A)', END=110) HEADCARD 
             WRITE(ID_TABOUT,*) HEADCARD
          ENDDO
C
      ELSEIF( I1 .EQ. 10 ) THEN
C
C         Read the staging cards which are in a different format.
C
          NTESTS = I2
          IF( NTESTS .LT. 1  .OR.  NTESTS .GT. MAXTESTS ) NTESTS = 1
C
          DO I = 1, NTESTS
             READ(ID_CADIN,106,END=110) A1, I1, I2, A2, R1, I3, I4
  106        FORMAT( A6, 2I5, 1X, A6, E15.9, 1X, I6, I5)
C             
             WRITE(ID_TABOUT,*) A1, I1, I2, A2, R1, I3, I4
  107        FORMAT( 1X, 2X, A6, 1X, I6, 1X, I6, 1X, A6, 1X, G15.5, 
     1               1X, I7, 1X, I7 )
C                  
          ENDDO  
C          
      ENDIF 
C     
C
      GOTO 70 
C
C  Error handler for reading CADIN.ASC file.  Executable CADIN.ASC records are
C  in a specific format.  This error handler will allow full length records for 
C  record type 4 (comment cards).  If not card type 4, end program.
C
  900 IF( I1 .EQ. 4 ) THEN
          BACKSPACE ID_CADIN
          READ( ID_CADIN, 910, END=110 ) I1, COMMENT
  910     FORMAT( I2, A70 )
C
          WRITE(ID_TABOUT,915) I1, COMMENT
  915     FORMAT(I2,'(A)')
          GOTO 70
      ELSE
          BACKSPACE ID_CADIN
          READ( ID_CADIN, '(A)') CADIN_LINE
          WRITE(ID_TABOUT,*) ' '
          WRITE(ID_TABOUT,*) ' Error reading CADIN.ASC'
          WRITE(ID_TABOUT,920) 'record: ', TRIM(CADIN_LINE)
          WRITE(ID_TABOUT,*) ' '
          WRITE(ID_TABOUT,*) ' RUN ABORTED '
          WRITE(ID_TABOUT,*) ' '
C
          STOP ' '
  920     FORMAT(8X,A,1X,A)
      ENDIF
C
  110 CONTINUE
C
C---  Force the following output to be at the top of page
      WRITE(ID_TABOUT,50)
C
C
      RETURN
      END
      SUBROUTINE SETRANDSEQ( INSEED ) 
C
C----------------------------------------------------------------------
C
C     This module establishes the starting point of the pseudorandom
C     number generator.  In order to start a new sequence of random
C     numbers, a new seed value is sent to the SEED function.
C
C----------------------------------------------------------------------
C
      CALL RANDOM_SEED( INSEED )                         ! MS statement.
C      
C---  SVS statement:  In order to start a new sequence of random
C     numbers, a negative value is sent to the random function, RAN.
C     CALL RANDU( - ABS(INSEED), IDUM, RDUM )      
C
      RETURN
      END
!--------------------------------------------------------------------
!
      FUNCTION SIGNFUNCT( VALUE )
!
!--------------------------------------------------------------------
!
!    This function generates a value equal to :
!               ABS( Value )      if  Rnum > 0.5  
!      or  ( -1 * ABS( Value) )   if  Rnum < 0.5
!    where Rnum is a uniform random number between 0 and 1.0 
!
!--------------------------------------------------------------------
!
! VALUE - (I) The absolute value to be returned by the function.  The 
!         function will return this value with a rangom sign. 
!
!--------------------------------------------------------------------
!
      RVALUE = ABS( VALUE )
      RNUM = RANF()
!
      IF( RNUM .LE. 0.5 ) THEN
          SIGNFUNCT = -1.0 * RVALUE
      ELSE
          SIGNFUNCT = RVALUE
      ENDIF
!
      RETURN
      END
C
C-------------------------------------------------------------------------
C
      FUNCTION SQR( A, PER, TC )
C
C-------------------------------------------------------------------------
C
C
C
C---Argument Definitions------------------------------------------------
C
C  A   - (R) Input.
C  PER - (R) Input.
C  TC  - (R) Input.
C  SQR - (R) Output. 
C
C-------------------------------------------------------------------------
C
      X = A
      TIP = AMOD( TC, PER )
C
      IF( TIP.GE. 0.5*PER ) X = - X
C
      SQR = X
C
C
      RETURN
      END
C
C-------------------------------------------------------------------------
C
      SUBROUTINE STGE2
C
C-------------------------------------------------------------------------
C
C
C-------------------------------------------------------------------------
C
      COMMON      C(3510)
C
      EQUIVALENCE (C(2011), KSTEP )
      EQUIVALENCE (C(2020), LCONV )
C
C
      LCONV = 0
      KSTEP = 1
C
      RETURN
      END
      SUBROUTINE STGE3( NSUB )
C
C-------------------------------------------------------------------------
C
C  This module calls the G4 module and, if the trajectories have not 
C  reached PCA or impact, check to see if a staging criteria has been 
C  met.
C
C  Modifications:
C    *  Modifications made under T9108 affecting the sweep variables 
C       and methodology.
C    *  Added Argument parameter to suppress extra staging message.
C    *  Some cleanup and structuring performed under T9108
C
C--Argument List Definitions--------------------------------------------
C
C NSUB - (I) Flag:  1 = STGE3 call from EXEC;  2= STGE3 called 
C            from SUBL3.  This is a flag that was added under T9108
C            to distinguish which module called STGE3.  The EXEC 
C            module calls the stage after reading input;  SUBL3 calls 
C            the stage after each module is called to determine if it 
C            is time to stage.  This can lead to the STGE module being 
C            called twice for the same stage criteria if the criteria 
C            is satisfied directly after an input or previous stage.
C            At this time it is undetermined if the double call is 
C            necessary.  This flag is used to prevent output messages 
C            from being printed until the SUBL3 module calls STGE3
C
C--Local Variable Definitions-------------------------------------------
C
C  STG_MET - (L) Flag that is true when a stage criteria has been met; 
C            otherwise, the flag value is false.
C
C-------------------------------------------------------------------------
C   
      COMMON          C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /OPFLAG/ INTMSG, STGMSGOUT, INECHO, XSWEEP
      LOGICAL         INTMSG, STGMSGOUT, INECHO, XSWEEP
C
      COMMON /OPPLOT/ IPLADD(70), INTPLOT(70)
      LOGICAL         INTPLOT
C
      COMMON /PREV/   TPREV, CPPREV, PPPREV
C
      COMMON /STAGE/  LOC(2), INCRS(2), VAL(2), UNITS(2), KODE(2), 
     1                TEST(2), LOCT(2), NTEST
C
      COMMON /STAGE1/ ISTAGE, NUMSTAGE  
C      
C
      DIMENSION  IC(3510)
C
      EQUIVALENCE (C(0001), IC(0001) )
      EQUIVALENCE (C(1772), TRCOND   )
      EQUIVALENCE (C(1800), ISWEEP   )
      EQUIVALENCE (C(1801), CRITNO   )
      EQUIVALENCE (C(1802), CRITVAL  )
      EQUIVALENCE (C(1805), CRITMAX  )
      EQUIVALENCE (C(1811), ANGLNO   )
      EQUIVALENCE (C(1821), RANGNO   )
      EQUIVALENCE (C(2000), TIME     )
      EQUIVALENCE (C(2001), TSTAGE   )
      EQUIVALENCE (C(2003), PCNT     )
      EQUIVALENCE (C(2011), KSTEP    )
      EQUIVALENCE (C(2014), ITCNT    )
      EQUIVALENCE (C(2020), LCONV    )
      EQUIVALENCE (C(2280), NV       )
      EQUIVALENCE (C(2866), ICOOR    )
C
      DIMENSION PDATA(70)
      LOGICAL   STG_MET
C
C
C---  Call the G4 module to test for the end of a trajectory either by 
C     impact or PCA
C
      CALL G4
C
C
      IF( LCONV .GE. 2 ) THEN
C
C         G4 has detected the  Point of Closest Approach or impact 
C         with the ground.  Stop the trajectory
C
C         Set the print time counter to (?) force last time printout.
C
          PCNT  = 0.0
C
C         Reset the integration flag = initialization mode.
C
          ICOOR = -1
C
C         Set the flag to control flow of execution in module EXEC
C
          KSTEP = 2
C
C         Call the auxillary modules one more time.
C
          CALL AUXSUB    
C
C         Call the output module 
C
          STG_MET = .FALSE.            ! Not called at a stage.
          CALL OUPT3( STG_MET )        ! Output the data to scroll/plot
C
C         If the critical value is less than the critical variable
C         but no terminate code is given, then the trajectory has been
C         stopped and not reached the correct end?  Prevent bad data
C         from being written to the sweep files.  The test for sweep is
C         greater than the critical value.  Assumption: sweep runs must
C         terminate with a termination code to be valid?
C
          ICRITNO = CRITNO          !really not needed BC
          CRITVAR = C( ICRITNO )    !really not needed BC
C
C--------------------------------------------------------------------------------
C
C          This is the old (XR94) if statement to determine if the trajectory
C          has reached the correct end.  This if statement is being replaced
C          to be based on LCONV instead of the value of the critical variable
C
C          IF( CRITVAR .LT. CRITVAL  .AND. TRCOND.LT. 0.9 ) THEN    !RETURN
C
C--------------------------------------------------------------------------------
C
          IF( LCONV .GT. 2 ) THEN
C
C---          Trajectory termination has occurred and has not reached the
C---          correct end (i.e. trajectory end outside terminal sphere)
C---          set critical variable to critmax and write this data to the
C---          sweep files           [added for XR97 - SWEEP5 Methodology]
              C( ICRITNO ) = CRITMAX
C
          ENDIF
C
C---      Check for changes in the minimum/maximum plot variable data. 
          CALL LD_MINMAX
C
C---      If this is a sweep case, write the final conditions to the 
C---      tape 10.
          IF( XSWEEP ) THEN
C
C---          Write the test criteria to the file.  Only do this for
C---          sweep option #4 and #5.  Other sweep options do not check the
C---          criteria data.
              IF( ISWEEP .GT. 3 ) 
     1            WRITE(ID_IMPACT10,*)
     2            C(INT(CRITNO)), C(INT(RANGNO)), C(INT(ANGLNO))
C
C---          Store the plot data corresponding to the trajectory.
C---          Load the current value of the plot variable
              DO I = 1, NV
                 IF( INTPLOT(I) ) THEN
                     PDATA(I) = IC( IPLADD(I) )
                 ELSE
                     PDATA(I) = C( IPLADD(I) )  
                 ENDIF
              ENDDO
C
              WRITE(ID_IMPACT7,*) ( PDATA(I), I=1, NV )
C
          ENDIF
C
C
      ELSE
C
C        Not the end of the trajectory.  Check to see if a staging 
C        criteria has been met.
C
         CALL STG_EVAL( STG_MET, NCRITERIA )
C
         IF( STG_MET ) THEN 
C
C            A staging criteria was met.  If printing is turned on, 
C            print a message.
C
             IF( STGMSGOUT ) THEN
C
C---             The output message is turned on and this module was 
C---             called from SUBL3
                 L = LOC( NCRITERIA )               ! C staging variable
C
                 WRITE(ID_TABOUT,500) 
     1              NUMSTAGE, NCRITERIA, L, C(2000)
  500            FORMAT( 1X, 'Stage ', I3, ' criteria # ', I2, 
     1                   ' satisfied.  Stage variable #: ', I6,
     2                   ' Time: ', G12.5  )
             ENDIF
C
C---         Call the module to print the stageing data if the stage 
C---         module is called from the SUBL3 module.  Prevent duplicating 
C---         output for the same stage criteria.
             IF( NSUB .GT. 1 ) CALL OUPT3( STG_MET )
C
C---         Reset the print flag.
             ITCNT  = 1
             TSTAGE = 0.0
             TPREV  = TIME
C
C---         Set the flag that controls execution in module EXEC 
             IF( ISTAGE .EQ. 16 ) THEN
C
C---             Process next stage input.
                 KSTEP = 3
             ELSE
C
C                Staging has occured and the end of trjaectory has been
C                signaled by a type 6 card
C
                 LCONV = 5
                 KSTEP = 2
             ENDIF
C
         ENDIF
C
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE STG_EVAL( STG_MET, NCRITERIA ) 
C
C-------------------------------------------------------------------------
C
C  Evaluate the staging criteria to determine if a stage condition has
C  been met.
C
C--Argument Definitions-------------------------------------------------
C
C  STG_MET - (L) Flag that is true when a stage criteria has been met or
C            false if conditions do not meet the stage criteria.
C  NCRITERIA - (I) When STG_MET is true, the number of the staging criteria 
C            that was satisfied;  Otherwise the data returned is not 
C            valid.
C
C-------------------------------------------------------------------------
C
      LOGICAL STG_MET
C
      COMMON      C(3510)
C
      COMMON /STAGE/  LOC(2), INCRS(2), VAL(2), UNITS(2), KODE(2), 
     1                TEST(2), LOCT(2), NTEST
C
C
      STG_MET = .FALSE.
      NCRITERIA = 0
C
C
C---  Test to see if there are any tests defined.
C
      IF( NTEST .LT. 1 ) RETURN 
C
C
C---  Tests are defined.
C     Check to see if any of the criteria tests are satisfied.
C
C
      DO I = 1, NTEST
C
         L = LOC(I)  ! C element location of staging variable
C
         IF( KODE(I) .LE. 0 ) THEN 
C       
C            Compare the staging variable to the value pre-computed 
C            and stored in the TEST array
C
             TESTVAL = TEST(I) 
         ELSE 
C
C            Compare the staging variable to the current value in 
C            a C array location
C
             L1 = LOCT(I)       ! Location of the staging criteria. 
             TESTVAL = C( L1 )
         ENDIF
C
         IF( C(L) .LT. TESTVAL ) THEN 
C
C            The stage variable is less than the stage criteria.
C            Only stage if the user has specified this relationship. 
C
             IF( INCRS(I) .LE. 0 ) THEN
                 STG_MET = .TRUE. 
                 NCRITERIA = I
                 RETURN 
             ENDIF
C
         ELSEIF( C(L) .GT. TESTVAL ) THEN 
C
C            The stage variable is greater than the stage criteria.
C            Only stage if the user has specified this relationship. 
C             
             IF( INCRS(I) .GT. 0 ) THEN
                 STG_MET = .TRUE. 
                 NCRITERIA = I
                 RETURN 
             ENDIF
C
         ELSE
C
C            The stage variable equals the stage criteria.  STAGE!
C
             STG_MET = .TRUE. 
             NCRITERIA = I
             RETURN 
C
         ENDIF
C
      ENDDO
C
C
      RETURN
      END
      SUBROUTINE STRT_PLOT( NPLOTVAR )
C
C-------------------------------------------------------------------------
C
C  This module writes the starting plot file data (title and header 
C  records ) 
C
C--Argument List Definitions-------------------------------------------
C
C NPLOTVAR - (I) Integer containing the number of variables input 
C            selected for plotting on the HEADER file.
C
C--Local Variable Definition--------------------------------------------
C
C CJUNK8     (C8) - Spacers for printing the acronyms to TRAJ.*
C
C------------------------------------------------------------------------
C 
C   29 September 1994:
C
C   The following variables were used to create a STAT.* file with 6
C   letter acronyms.  The file now creates 8 letter acronyms, but the
C   code was saved in case it is necessary to return to 6 letter acronyms.
C  
C CJUNK      (C6) - Spacers for printing the acronyms to tape 44.  These 
C            acronyms are only 6 characters.  Utility programs have not 
C            been modified to handle the  8 char. acronyms.
C BLABLE(44) (C6) - The 6 char. acronyms for STAT.* data.  Utility 
C            programs have not been modified to handle 8 chars to adapt 
C            the acronyms to the 6 char length.
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /HCOM/    TITLE
      CHARACTER        TITLE*100  
C
      COMMON /OPPLTC/  ALABLE
      CHARACTER        ALABLE(70)*8
C
      COMMON /OPINIT/  IPLINIT(70), INTPINIT(70), NINITVAR
      LOGICAL          INTPINIT
C
      COMMON /OPINITC/ INITLAB
      CHARACTER        INITLAB(70)*8
C
      COMMON /OPTRACK/  IPLTRACK(70), INTPTRACK(70), NTRACKVAR
      LOGICAL           INTPTRACK
C
      COMMON /OPTRACKC/ TRACKLAB
      CHARACTER         TRACKLAB(70)*8
C
C
      CHARACTER CJUNK8*8                ! , CJUNK*6, BLABLE(70)*6             
      DATA CJUNK8 / '        '/         !  ,  CJUNK/'      '/
C
C
C---  Write headers and acronyms to TRAJ.BIN file if a binary trajectory 
C---  file is being created. 
      IF( TRAJBIN ) THEN
        WRITE(ID_TRAJBIN) TITLE
        WRITE(ID_TRAJBIN) INT( C(1982) ), INT( C(1983) ), NPLOTVAR 
        WRITE(ID_TRAJBIN) ( ALABLE(J), CJUNK8, J=1, NPLOTVAR )
      ENDIF         
C
C---  Write headers and acronyms to TRAJ.ASC file if an ascii trajectory 
C---  file is being created. 
      IF( TRAJASC ) THEN
        WRITE(ID_TRAJASC,100 ) '1', TITLE  
  100   FORMAT( A, A )        
        WRITE(ID_TRAJASC,110) INT( C(1982) ), INT( C(1983) ), NPLOTVAR 
  110   FORMAT( 1X, 3( I2, 1X ) )
        WRITE(ID_TRAJASC,120) ( ALABLE(J), CJUNK8, J=1, NPLOTVAR )
  120   FORMAT( 5( A8, A8 ) )     
      ENDIF         
C
C
C---  Write the headers and acronyms to the STAT.* file.
C     Utility programs for STAT.* data have not been updated to 
C     handle 8 char acronyms.  Adapt the 8 char acronyms to 
C     maintain the 6 on tape 44.
C
C---  29 Sep 1994: STAT.* creates 8 letter acronyms, comment out
C---  code to create 6 letter acronyms. 
C
C      DO J = 1, NPLOTVAR
C         BLABLE(J)(1:6) = ALABLE(J)(1:6)
C      END DO                       
C
C---  Write headers and acronyms to STAT.BIN file if a binary statistics 
C---  file is being created.
      IF( STATBIN ) THEN
        WRITE(ID_STATBIN) TITLE
        WRITE(ID_STATBIN) INT( C(1982) ), INT( C(1983) ), NPLOTVAR
        WRITE(ID_STATBIN) ( ALABLE(J), CJUNK8, J=1, NPLOTVAR )
      ENDIF
C 
C---  Write headers and acronyms to STAT.ASC file if an ascii statistics 
C---  file is being created.
      IF( STATASC ) THEN
        WRITE(ID_STATASC,100 ) '1', TITLE  
        WRITE(ID_STATASC,110) INT( C(1982) ), INT( C(1983) ), NPLOTVAR 
        WRITE(ID_STATASC,120) ( ALABLE(J), CJUNK8, J=1, NPLOTVAR )
      ENDIF         
C
C---  Write data to the RT CADAC files -------------------------------------
C---  Write headers and acronyms to INIT.BIN file if a binary initialization
C---  file is being created.
      IF( INITBIN ) THEN
        WRITE(ID_INITBIN) TITLE
        WRITE(ID_INITBIN) INT( C(1982) ), INT( C(1983) ), NINITVAR
        WRITE(ID_INITBIN) ( INITLAB(J), CJUNK8, J=1, NINITVAR )
      ENDIF
C 
C---  Write headers and acronyms to INIT.ASC file if an ascii initialization 
C---  file is being created.
      IF( INITASC ) THEN
        WRITE(ID_INITASC,100 ) '1', TITLE  
        WRITE(ID_INITASC,110) INT( C(1982) ), INT( C(1983) ), NINITVAR 
        WRITE(ID_INITASC,120) ( INITLAB(J), CJUNK8, J=1, NINITVAR )
      ENDIF         
C
C---  Write headers and acronyms to TRACK.BIN file if a binary track
C---  data file is being created.
      IF( TRACKBIN ) THEN
        WRITE(ID_TRACKBIN) TITLE
        WRITE(ID_TRACKBIN) INT( C(1982) ), INT( C(1983) ), NTRACKVAR
        WRITE(ID_TRACKBIN) ( TRACKLAB(J), CJUNK8, J=1, NTRACKVAR )
      ENDIF
C 
C---  Write headers and acronyms to TRACK.ASC file if an ascii track 
C---  data file is being created.
      IF( TRACKASC ) THEN
        WRITE(ID_TRACKASC,100 ) '1', TITLE  
        WRITE(ID_TRACKASC,110) INT( C(1982) ), INT( C(1983) ), 
     1                         NTRACKVAR 
        WRITE(ID_TRACKASC,120) ( TRACKLAB(J), CJUNK8, J=1, NTRACKVAR )
      ENDIF         
C
C
C---  At Dr.Zipfel's request the code to create a tape45 was commented
C---  out.  (29 Sep 1994)
C      WRITE(45,'(A)' )  '1' // TITLE
C      WRITE(45,*)  INT( C(1982) ), INT( C(1983) ), NPLOTVAR
C      WRITE(45, 100 )  (  ALABLE(J), CJUNK8, J=1, NPLOTVAR )
C  100 FORMAT( 1X, 5( A, A ) )				   
C
C
      RETURN
      END
      SUBROUTINE SUBL1
C
C-------------------------------------------------------------------------
C
C     This module controls the execution of the user-selected 
C     modules.  The module numbers are entered on Type ___ cards.  
C     Up to 99 cards may be entered.  Module numbers must be between 
C     1 and 9 inclusive with the following definitions:
C         Module #    Module Name 
C
C     NOTE:  NO modules are called by execution by this module.
C
C-------------------------------------------------------------------------
C
      COMMON      C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      DIMENSION              SUBNO(99)
C
      EQUIVALENCE (C(2461), NOSUB )   
      EQUIVALENCE (C(2462), SUBNO(1) ) 
C
C     NOSUB  = The number of subroutines to execute. 
C     SUBNO(1) = The associated subroutine numbers to be executed
C
C
      DO 1 I = 1, NOSUB 
C
C        Get the module number to execute.
C
         J = SUBNO(I)
C
C        Go execute the module.
C
         GO TO ( 1, 2, 3, 4, 5, 6, 7, 8, 9 ), J
         WRITE(ID_TABOUT,*) '  GOTOER IN SUBL1, J = ',J
C
C
    2    CONTINUE
         GO TO 1
C
    3    CONTINUE 
         GO TO 1
C
    4    CONTINUE
         GO TO 1
C
    5    CONTINUE
         GO TO 1
C
    6    CONTINUE
         GO TO 1
C
    7    CONTINUE
         GO TO 1
C
    8    CONTINUE
         GO TO 1
C
    9    CONTINUE
C
C
    1 CONTINUE
C
C
C
      RETURN
      END
C
C-------------------------------------------------------------------------
C
      SUBROUTINE SUBL2
C
C-------------------------------------------------------------------------
C
C     This module controls the execution of the initialization modules 
C     for the modules selected with input card type 1. 
C     Up to 99 cards may be entered.  Module numbers must be between 
C     1 and 9 inclusive with the following definitions:
C         Module #    Module Name 
C             3         OUPT2 - Initializatioin for OUPT3
C             4         STGE2 - Initialization for STGE3
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      DIMENSION              SUBNO(99)
C
      EQUIVALENCE (C(2461), NOSUB )    
      EQUIVALENCE (C(2462), SUBNO(1) )  
C
C     NOSUB    = The number of subroutines to execute. 
C     SUBNO(1) = The associated subroutine numbers to be executed
C
C
      DO 1 I = 1, NOSUB 
C
C        Get the sub-module  number.
C
         J = SUBNO(I)  
C
C        Go execute the sub-module.
C
         GO TO ( 1, 2, 3, 4, 5, 6, 7, 8, 9 ), J
         WRITE(ID_TABOUT,*) '  GOTOER IN SUBL2, J = ',J
C
C
    2    CONTINUE
         GO TO 1
C
    3    CONTINUE
         CALL OUPT2
         GO TO 1
C
    4    CONTINUE
         CALL STGE2
         GO TO 1
C
    5    CONTINUE
         GO TO 1
C
    6    CONTINUE
         GO TO 1
C
    7    CONTINUE
         GO TO 1
C
    8    CONTINUE
         GO TO 1
C
    9    CONTINUE
C
C
    1 CONTINUE
C
C
C
      RETURN
      END 
      SUBROUTINE SUBL3
C
C-------------------------------------------------------------------------
C
C     This module controls the execution of the user-selected Cadac
C     modules.  The module numbers are entered on Type 1 cards.  
C     Up to 99 cards may be entered.  Module numbers must be between 
C     1 and 9 inclusive with the following definitions:
C         Module #    Module Name 
C             3          OUPT3 - Controls output to scroll and plot
C             4          STGE3 - 
C
C     NOTE: This module is similar to SUBL2 with the following 
C           differences:  
C           (1) Modules that are executed are different
C           (2) Variable C(1) is modified by this module.
C
C-------------------------------------------------------------------------
C
      LOGICAL  STGEMET
C
      COMMON      C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      DIMENSION              SUBNO(99)
C
      EQUIVALENCE (C(2461), NOSUB )    
      EQUIVALENCE (C(2462), SUBNO(1) )  
C
C     NOSUB  = The number of subroutines to execute. 
C     SUBNO(1) = The associated subroutine numbers to be executed
C
C
      C(1) = AMIN1( C(1), 0.1 )
C
      DO 1 I = 1, NOSUB 
C
C        Obtain the first sub-module number to be executed.
C
         J = SUBNO(I)          
C
C        Go execute the sub-module
C
         GO TO ( 1, 2, 3, 4, 5, 6, 7, 8, 9 ), J
         WRITE(ID_TABOUT,*) '  GOTOER IN SUBL3, J = ',J
C
C
    2    CONTINUE
         GO TO 1
C
    3    CONTINUE
C
C        Call the module that prints data to scroll and to the plot 
C        file.
C
         STGEMET = .FALSE.       ! Not called when a stage is met.
         CALL OUPT3( STGEMET )
         GO TO 1
C
    4    CONTINUE
C
         ICALL = 2
         CALL STGE3( ICALL )
         GO TO 1
C
    5    CONTINUE
         GO TO 1
C
    6    CONTINUE
         GO TO 1
C
    7    CONTINUE
         GO TO 1
C
    8    CONTINUE
         GO TO 1
C
    9    CONTINUE
C
C
    1 CONTINUE
C
C
      C(1) = 0.0
C
C
      RETURN
      END
      FUNCTION TRI( AMP, PER, T )
C
C-------------------------------------------------------------------------
C
C
C--Argument Definitions-------------------------------------------------
C
C  AMP - (R) Input. 
C  PER - (R) Input. 
C  T   - (R) Input. 
C  TRI - (R) Output.
C
C-------------------------------------------------------------------------
C
      DIMENSION B(4), S(4)
C
      DATA B/ 0.0, 1.0, 0.0, -1.0 /,  S/ 4.0, -4.0, -4.0, 4.0 /
C
C
      TIP = AMOD( T, PER )
      A = 4 * TIP
      NQP = A/PER + 1.0
C
      TRI = AMP * B(NQP)  +  S(NQP) * AMOD( T/PER, 0.25) * AMP
C
C
      RETURN
      END
C
C-------------------------------------------------------------------------
C
      FUNCTION UNIF( R, XM )
C
C-------------------------------------------------------------------------
C
C     This module returns a uniform random variable based on a given 
C     mean and the width from the mean of the uniform function.
C
C--Argument Definitions-------------------------------------------------
C
C  R    - (R) Input. The distance on the axis from the mean to the upper 
C             limit of the uniform function.
C  XM   - (R) Input. The mean of the uniform function.
C  UNIF - (R) Output. A uniform stochastic variable whose function is 
C             centered about XM and the width of the function is 2 * R
C
C-------------------------------------------------------------------------
C
      UNIF = XM  +  2.0 * R * ( RANF()-0.5 )
C
C
      RETURN
      END
      SUBROUTINE WORK
C
C-------------------------------------------------------------------------
C
C     This module moves the initialization input card data from the 
C  input storage arrays into the working space arrays.  
C
C-------------------------------------------------------------------------
C
      COMMON /C7SVD/   IC7S0, C7S0(10,20), IC7SN(20), C7SN(20,5,20)
C 
      COMMON /C7WKD/  IWC7S0, WC7S0(10,20), IWC7SN(20), WC7SN(20,5,20)
C 
      COMMON /IPSAV/   NCARDS, NHOL, JTYPES(500), LOCS(500), MODS(500), 
     1                 VA1S(500), VA2S(500), MOD2(500)
C
      COMMON /IPSAVC/  ALS(3,500), HOLS(5)
      CHARACTER        ALS*6, HOLS*80
C
      COMMON /IPSVSC/  MCRIS(20,2,4), VALS(20,2)
C
      COMMON /IPSVSCC/ MCRISC(20,2,2)
      CHARACTER        MCRISC*6
C
      COMMON /IPSVST/  JTSTS(20,60), LOCSTS(20,60), MODSTS(20,60), 
     1                 VA1STS(20,60), VA2STS(20,60), MOD2ST(20,60),
     2                 NCD(20)
C
      COMMON /IPSVSTC/ ALSTS(20,3,60)
      CHARACTER        ALSTS*6
C
      COMMON /IPSVWD/  NWX, WXS(6,50) 
C
      COMMON /WINDS/   WALT(50), WDIR(50), WVEL(50), RHX(50), 
     1                 CTMP(50), WPRES(50), NWINDR, RHW
C
      COMMON /WSET/    NCARD, JTYPE(500), LOCA(500), MOE(500), 
     1                 VA1(500), VA2(500), M2(500)
C
      COMMON /WSETC/   AL(3,500), HOLL(5)
      CHARACTER        AL*6, HOLL*80
C
      COMMON /WSETSC/  MCRI(20,2,4), WVAL(20,2)
C
      COMMON /WSETSCC/ MCRIC(20,2,2)
      CHARACTER        MCRIC*6
C
      COMMON /WSETST/  NCDW(20), JTST(20,60), LOCST(20,60), 
     1                 MODST(20,60), VA1ST(20,60), VA2ST(20,60),
     2                 M2ST(20,60)
C
      COMMON /WSETSTC/ ALST(20,3,60)
      CHARACTER        ALST*6
C
      COMMON /WSETWT/  WX(6,50)
C
C
C
      IWC7S0 = 0
      NSTAGE = 0
C
C     Transfer the number of cards from the SAVED initialization deck 
C     to the working variable.
C
      NCARD = NCARDS
C
C     Transfer the initialization data from the storage arrays into the 
C     working arrays.
C
      DO I = 1, NCARD
C
C        Shift data into the working (?) arrays.
C
         JTYPE(I) = JTYPES(I)
         LOCA(I)  = LOCS(I)
         MOE(I)   = MODS(I)
C
         DO J = 1,3
            AL(J,I) = ALS(J,I)
         ENDDO
C
         VA1(I) = VA1S(I)
         VA2(I) = VA2S(I)
         M2(I)  = MOD2(I)
C
C---     If card types 7, 8, 9 or 10 are encountered, transfer the data 
C        accordingly.
C
         IF( JTYPES(I) .EQ. 7 ) THEN 
C
C            Card type 7 : Transfer vector data for stage 0
C
             IWC7S0 = IWC7S0 + 1
C
             DO IELEM = 1, MOE(I)
                WC7S0( IWC7S0, IELEM ) = C7S0( IWC7S0, IELEM )
             ENDDO
C
C
         ELSEIF( JTYPES(I) .EQ. 8 ) THEN 
C
C            Card type 8 : Load atmospheric data into working array.
C
             NWINDR = NWX
             DO J = 1, NWINDR
                DO M = 1, 6
                   WX(M,J) = WXS(M,J)
                ENDDO
             ENDDO
C
C
         ELSEIF( JTYPES(I) .EQ. 9 ) THEN 
C
             NUMHOL = LOCA(I)
C
             DO J = 1, NUMHOL
                HOLL(J) = HOLS(J)
             ENDDO 
C
C
         ELSEIF( JTYPES(I) .EQ. 10 ) THEN 
C
             NSTAGE = NSTAGE + 1
             NCDW(NSTAGE) = NCD(NSTAGE)
C
             NTEST = LOCA(I)
             IF( NTEST .NE. 1  .AND.  NTEST .NE. 2 ) NTEST = 1
C
             DO 80 K=1, NTEST
                DO L = 1, 4
                   MCRI(NSTAGE,K,L) = MCRIS(NSTAGE,K,L)
                ENDDO
C
                MCRIC(NSTAGE,K,1) = MCRISC(NSTAGE,K,1)
                MCRIC(NSTAGE,K,2) = MCRISC(NSTAGE,K,2)
                WVAL(NSTAGE,K) = VALS(NSTAGE,K)
   80        CONTINUE
C
C            Transfer the data for the next stage:
C
             K = NCD(NSTAGE)
C
             IF( K .GE. 1 )  THEN 
C
                 DO 95 NN=1,K
C
                    JTST(NSTAGE,NN)  = JTSTS(NSTAGE,NN)
                    LOCST(NSTAGE,NN) = LOCSTS(NSTAGE,NN)
                    MODST(NSTAGE,NN) = MODSTS(NSTAGE,NN)
                    VA1ST(NSTAGE,NN) = VA1STS(NSTAGE,NN)
                    VA2ST(NSTAGE,NN) = VA2STS(NSTAGE,NN)
                    M2ST( NSTAGE,NN) = MOD2ST(NSTAGE,NN)
C
                    DO M = 1,3
                       ALST(NSTAGE,M,NN) = ALSTS(NSTAGE,M,NN)
                    ENDDO
C
   95            CONTINUE
C
C                Transfer any type 7 data for this stage.
C
                 IWC7SN( NSTAGE ) = IC7SN( NSTAGE )
C
                 DO ISTG = 1, 5
                    DO IELEM = 1, 20
                       WC7SN( NSTAGE, ISTG, IELEM ) = 
     1                        C7SN( NSTAGE, ISTG, IELEM )
                    ENDDO
                 ENDDO
C
C
             ENDIF
C
         ENDIF
C
      ENDDO
C
C
      RETURN
      END
      SUBROUTINE OINPT2
C
C-------------------------------------------------------------------------
C
C  This module is used at a severe error or when the trajectory has
C  impacted to the ground.  This module bypasses all of the cards in the 
C  input deck until the type 6 card is found.   It also maintains the 
C  value of ISAVE prior to the skipping cards.  If a type 90 card is 
C  found in the cards being skipped, the ISAVE flag will be reset to the
C  original value since the data contained in the tape 90 file is likely 
C  to be invalid.
C  
C--Local Variable Definitions-------------------------------------------
C
C  IO_* = (I) The original values of the corresponding variables.  These
C          values are restored to the variables after the cards are 
C          skipped.  ( IO_IBEEN, IO_IBEGIN, IO_ICARD, IO_ISAVE ) 
C
C-------------------------------------------------------------------------
C
      COMMON /NAD/    IBEEN, IBEGIN, ICARD, ISAVE
C
C
C     Save the value in ISAVE prior to skipping the cards.
C
      IO_IBEEN  = IBEEN
      IO_IBEGIN = IBEGIN
      IO_ICARD  = ICARD
      IO_ISAVE  = ISAVE
C
C     Skip all cards until the next type 16 or 6 card.
C
      CALL OINPT1
C
C     If a type 90 card is encountered in the skip cards, the ISAVE 
C     flag will be set.  Restore the value of ISAVE to the original value.  
C
      IBEEN  = IO_IBEEN   
      IBEGIN = IO_IBEGIN  
      ICARD  = IO_ICARD   
      ISAVE  = IO_ISAVE   
C
C
      RETURN
      END
      SUBROUTINE C19_PROCESS( IR2, MODE, VR, MINT, ISWTH )
C
C-----------------------------------------------------------------------
C
C  This module reads the card data for the outer loop variable 
C  definition and limits. 
C
C--Argument List Definitions--------------------------------------------
C
C  The definitions of these variables is dependant on the card type.
C
C  IR2   - (I) Contains the SECOND integer value from the input card 
C          that is currently being processed.  For this card type - 
C          the variable is the element location in C of the outer
C          loop variable.  This variable should be the angle component 
C          of a polar coordinate system for compatibility with SLAP
C  MODE  - (I) Contains an integer flag from the input card that is 
C          currently being processed.  For this type - this variable 
C          contains the delta/increment for the angle.  
C  VR(2) - (R) Contains the real data from the input card that is 
C          currently being processed. For this type - variable (1) 
C          contains the minimum angle (2) contains the maximum angle.
C  MINT  - (I) The fourth integer on the card input;  the units of the 
C          data:  0 = degrees - conversion necessary; 1 = radians - no 
C          conversions necessary.
C
C-----------------------------------------------------------------------
C
      DIMENSION VR(2)
C
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C
      EQUIVALENCE (C(1811), ANGLNO )
      EQUIVALENCE (C(1812), ANGMIN )
      EQUIVALENCE (C(1813), ANGMAX )
      EQUIVALENCE (C(1814), ANGDEL )
      EQUIVALENCE (C(1815), ANGUNT )
C
C
      ANGLNO = IR2
      ANGMIN = VR(1)
      ANGMAX = VR(2)
      ANGDEL = MODE
      ANGUNT = MINT
C
C
      IF( ANGMIN .GT. ANGMAX ) THEN 
          WRITE(ID_TABOUT,*)
          WRITE(ID_TABOUT,*)
     1      '*** ERROR - CARD 19 - MIN GREATER THAN MAX ***'
          WRITE(ID_TABOUT,*) 
          ISWTH = 19
      ENDIF
C
      IF( ANGDEL .LE. 0.0 ) THEN 
          WRITE(ID_TABOUT,*)
          WRITE(ID_TABOUT,*) 
     1        '*** ERROR - CARD 19 - DELTA LESS OR EQUAL TO 0.0 ***'
          WRITE(ID_TABOUT,*) 
          ISWTH = 19
      ENDIF
C
      IF( ANGLNO .LE. 0.0 ) THEN 
          WRITE(ID_TABOUT,*)
          WRITE(ID_TABOUT,*)
     1      '*** ERROR - CARD 19 - INVALID ANGLE NUMBER ***'
          WRITE(ID_TABOUT,*) 
          ISWTH = 19
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE C20_PROCESS( IR2, MODE, VR, ISWTH )
C
C-----------------------------------------------------------------------
C
C  This module reads the card data for the INNER loop variable 
C  definition and limits plus some option flags.
C
C--Argument List Definitions--------------------------------------------
C
C  The definitions of these variables is dependant on the card type.
C
C  IR2   - (I) Contains the SECOND integer value from the input card 
C          that is currently being processed.  For this card type - 
C          the variable is the element location in C of the outer
C          loop variable.  This variable should be the range component 
C          of a polar coordinate system for compatibility with SLAP
C  MODE  - (I) Contains an integer flag from the input card that is 
C          currently being processed.  For this type - this variable 
C          contains the delta/increment for the range.
C  VR(2) - (R) Contains the real data from the input card that is 
C          currently being processed. For this type - variable (1) 
C          contains the minimum range (2) contains the maximum range.
C
C-----------------------------------------------------------------------
C
      DIMENSION VR(2)
C
C
      COMMON  C(3510)
C      
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C
      EQUIVALENCE (C(1821), RANGNO )
      EQUIVALENCE (C(1822), RANMIN )
      EQUIVALENCE (C(1823), RANMAX )
      EQUIVALENCE (C(1824), RANDEL )
C
C
      RANGNO = IR2
      RANMIN = VR(1)
      RANMAX = VR(2)
      RANDEL = MODE
C
C
      IF( RANMIN .GT. RANMAX ) THEN 
          WRITE(ID_TABOUT,*)
          WRITE(ID_TABOUT,*)
     1      '*** ERROR - CARD 20 - MIN GREATER THAN MAX ***'
          WRITE(ID_TABOUT,*) 
          ISWTH = 20
      ENDIF
C
      IF( RANDEL .LE. 0.0 ) THEN 
          WRITE(ID_TABOUT,*)
          WRITE(ID_TABOUT,*) 
     1         '*** ERROR - CARD 20 - DELTA LESS OR EQUAL TO 0.0 ***'
          WRITE(ID_TABOUT,*) 
          ISWTH = 20
      ENDIF
C
      IF( RANGNO .LE. 0.0 ) THEN 
          WRITE(ID_TABOUT,*)
          WRITE(ID_TABOUT,*)
     1      '*** ERROR - CARD 20 - INVALID RANGE NUMBER ***'
          WRITE(ID_TABOUT,*) 
          ISWTH = 20
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE C21_PROCESS( IR2, MODE, VR, MINT, ISWTH )
C
C
C-----------------------------------------------------------------------
C
C  This module reads the card data for the sweep criteria definition. 
C
C--Argument List Definitions--------------------------------------------
C
C  The definitions of these variables is dependant on the card type.
C
C  IR2   - (I) Contains the SECOND integer value from the input card 
C          that is currently being processed.  For this card type - 
C          the variable is the element location in C of the critical
C		 number.
C  MODE  - (I) Contains an integer flag from the input card that is 
C          currently being processed.  For this type - this variable 
C          contains the current sweep methodology option.
C  VR(2) - (R) Contains the real data from the input card that is 
C          currently being processed. For this type - variable (1) 
C          contains the critical value and (2) contains the critical
C          when the trajectory terminates outside the terminal sphere
C		 (this value is what is written to the IMPACT7 file
C		 for LCONV = 4, added during XR97).
C  MINT  - (I) The fourth integer on the card input.  For this type - 
C		 the variable is the number of binary searches to be
C		 performed.
C
C-----------------------------------------------------------------------
C
      DIMENSION VR(2)
C
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C
      EQUIVALENCE (C(1800), ISWEEP  )
      EQUIVALENCE (C(1801), CRITNO  )
      EQUIVALENCE (C(1802), CRITVAL )
      EQUIVALENCE (C(1803), SEARNO  )
      EQUIVALENCE (C(1804), NUMR    )
C
C
      ISWEEP  = MODE
      CRITNO  = IR2
      CRITVAL = VR(1)
      SEARNO  = MINT
      NUMR    = VR(2)
C
C
      IF( ISWEEP .GT. 3 ) THEN 
C
C         Sweep option 4 or 5 selected.  Check other variables 
C		for valid data.
C
          IF( CRITNO .LE. 0.0   .OR.  CRITNO .GT. 3510.0  ) THEN 
              WRITE(ID_TABOUT,*)
              WRITE(ID_TABOUT,*) 
     1               '*** CARD 21 ERROR: INVALID CRITERIA NUMBER ***'
              WRITE(ID_TABOUT,*) '  CRITNO = ', CRITNO
              WRITE(ID_TABOUT,*) 
              ISWTH = 21
          ENDIF
C
          IF( SEARNO .LT. 0.0  ) THEN 
              WRITE(ID_TABOUT,*)
              WRITE(ID_TABOUT,*) 
     1                '*** CARD 21 ERROR: INVALID SEARCH NUMBER ***'
              WRITE(ID_TABOUT,*) '  SEARNO = ', SEARNO 
              WRITE(ID_TABOUT,*) 
              ISWTH = 21
          ENDIF
C
C
      ELSEIF( ISWEEP .GE. 0  .AND.  ISWEEP .LT. 4 ) THEN 
C
C         Options 0 - 3 selected.  Check the NUMR variable.
C
          IF( NUMR .LT. 1.0  ) THEN 
              WRITE(ID_TABOUT,*)
              WRITE(ID_TABOUT,*) 
     1              '*** CARD 21 ERROR: INVALID NUMBER OF RUNS ***'
              WRITE(ID_TABOUT,*) '  NUMR = ', NUMR
              WRITE(ID_TABOUT,*) 
              ISWTH = 21
          ENDIF
C
C
      ELSE 
C
C         Invalid Sweep option entered.
C
          WRITE(ID_TABOUT,*)
          WRITE(ID_TABOUT,*)
     1      '*** ERROR - CARD 21 - INVALID SWEEP MODE ***'
          WRITE(ID_TABOUT,*) '    ISWEEP = ', ISWEEP
          WRITE(ID_TABOUT,*) 
          ISWTH = 21
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE C3_PROCESS( IR2, VR, MODE, ALPHA3, ISWTH )
C
C-------------------------------------------------------------------------
C
C  Card type 3 : Variable initialization Cards.  These cards 
C  allow values to be assigned to the C common variable 
C  locations.
C
C    Card Format: 
C      Column       Description
C        1-2         (I) "03" = Card type number
C        3-8         (C) Variable Name (Not used)
C        9-14        (C)
C       15-20        (C) Variable Style. (ALPHA3)
C       21-25        (I) Variable Number (IR2)
C       26-30        (I) Variable Initialization Flag (MODE)
C       31-45        (R)  (VR1)
C       46-60        (R)  (VR2)
C       61-62        (I) Stage number for multi run cases.
C
C--C Element List Definitions--------------------------------------------
C
C  C(0059) = OPNORO - Option flag: 1 = NON-rotating earth model 
C            WEII3 = 0.0 ;  
C            0 = Rotating earth model : WEII3 = 7.2921154E-05; 
C            
C  When the OPNORO flag is set by the type 3 card, perfrom the necessary
C  modifications to the WEII3 variable.  Equivalence this variable in
C  this module so that it can be detected by EQSORT and checked for 
C  possible duplications of assignments with the modules.
C
C--Argument List Definitions--------------------------------------------
C
C  IR2    - (I) Input. The second integer input on the card = submodule 
C               number.
C  VR(I)  - (R) Input. The two real values input on the card. 
C  MODE   - (I) Input. The variable Initialization flag input on the 
C               card.
C  ALPHA3 - (C6) Input. The third character variable input on the card.
C               Must equal:  'UNIF  ', 'GAUSS ', 'RAYLEI', 'EXPO  ', 
C               'SIGN  ', or, 'EQUALS' 
C  ISWTH  - (I) Output. Input Error flag.
C
C--Local Variable Definitions-------------------------------------------
C
C  ICARDTYPE - (I) The card type that is currently being processed.
C
C-------------------------------------------------------------------------
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /KRUN/    JRUN, MULRUN, IGROUP
C
      COMMON /OPFLAG/ INTMSG, STGMSGOUT, INECHO, XSWEEP
      LOGICAL         INTMSG, STGMSGOUT, INECHO, XSWEEP
C
      COMMON  C(3510)
C
      DIMENSION IC(3510)
C
      EQUIVALENCE (C(0001), IC(1)   )
      EQUIVALENCE (C(0051), REARTH  )
      EQUIVALENCE (C(0054), AGRAV   )
      EQUIVALENCE (C(0055), CFTM    ) 
      EQUIVALENCE (C(0057), AMU     )
      EQUIVALENCE (C(0058), WEII3   )
      EQUIVALENCE (C(0059), OPNORO  ) 
      EQUIVALENCE (C(0090), RANSEED )
C
C
C
      DIMENSION VR(2)     
      CHARACTER ALPHA3*6
      INTEGER   SEEDFLAG
C
      DATA SEEDFLAG/ 0 /
C
C
C
      ICARDTYPE = 3
C
C
C---  Check for an invalid variable number (C location) to be 
C     initialized.
C
      IF( IR2 .LE. 0  .OR.  IR2 .GT. 3510 ) THEN
          ISWTH = 103
          CALL OIN1_EMSG( ICARDTYPE )
          RETURN
      ENDIF
C
C
C---  Process the card - assign the data to the variable as requested:
C
      IF( MODE .GT. 0 ) THEN
C
C         'Integer' Variable - truncate any decimal and assign to
C         the input value.  See Section 3.3.2.
C
          IC( IR2 ) = VR(1) 
C
      ELSE
C
C         'Real' Variable - Determine if stochastic or deterministic. 
C         See Section 3.3.1 and 3.3.3.
C
          IF( ALPHA3 .NE. '      ' ) THEN 
C   
C             Stochastic variable
C
              CALL C3_STOC_SET( IR2, ALPHA3, VR )
C
          ELSE
C
C             Discrete REAL variable. Section 3.3.1
C
              C( IR2 ) = VR(1)
C
          ENDIF
C
      ENDIF
C
C
C---  Check for special/flag variables that require action when they are 
C     set:
C
C
      IF( IR2 .EQ. 53   .AND.   VR(1) .GE. 0.001 ) THEN 
C
C         Variable OPTMET : the Metric option flag value has been set
C         to select the metric option.  Convert earth constants from 
C         feet to meters.
C
C         NOTE:  this is a one way conversion:  The default option for 
C         the program is the English system.  When the flag is set 
C         greater than 0, the program switches to the Metric system.
C         Notice that no provisions are made in the program to switch
C         back to the English system by setting the flag back to 0.
C         This was the way the program was designed prior to 91-08.
C         BUT if it is set, the user shouldn't be switching back and 
C         forth. 
C
          REARTH = REARTH * CFTM
          AGRAV  = AGRAV * CFTM
          AMU    = AMU * ( CFTM**3. )  
C          
      ENDIF
C
C
      IF( IR2 .EQ. 59  .AND.  VR(1) .LT. 0.5 ) THEN
C
C         Variable OPNORO :  = 0 = NON-Rotating earth model flag has 
C         been set to 0 which selects the rotating earth model.  Set 
C         the angular rotation of the earth (radians/sec).  
C
          WEII3 = 7.29211514E-5
C
      ELSEIF( IR2 .EQ. 59  .AND.  VR(1) .GT. 0.5 ) THEN
C
C         Variable OPNORO :  = 1 = NON-Rotating earth model flag has 
C         been set to 1 which selects the NON rotating earth model.  Set 
C         the angular rotation of the earth (radians/sec) to 0.0
C
          WEII3 = 0.0
      ENDIF
C
C
C
      IF( IR2 .EQ. 90 ) THEN
C
C         Variable RANSEED:  Randon number function seed value entered.  
C
C         Determine the initialization mode for the random function 
C         generator:
C             VR(2) = 0  =>   Call ranset once at the beginning of the 
C                             entire CADAC run and use  seed = VR(1)
C                             This is compatible with the original 
C                             ranseed method added under T90?? and can 
C                             be used to re-run a single trajectory 
C                             of a multi-run group.
C
C             VR(2) = 1  =>   Call ranset when the card is processed,
C                             regardless of the number of times occurrs 
C                             in the input and regardless of where the 
C                             card occurrs in the input. 
C                             Use  seed = VR(1) // "01"
C
C             VR(2) = 2  =>   Call ranset at the beginning of each 
C                             trajectory ( and tape 90? ) and use   
C                             seed = F( RANSEED, JRUN, IGROUP )
C                             This is so that individual trajectories 
C                             from a series may be executed singly
C
C             VR(2) = 3  =>   Call ranset at the beginning of each 
C                             trajectory ( and tape 90? ) and use
C                             seed = F( RANSEED, JRUN, 1 )
C                             to generate the same set of seeds for 
C                             every group of trajectories.
C
C                             
C         NOTE:  It is the responsibility of the user to initialize this 
C         seed value prior to the start of the first trajectory.  If the 
C         card type 3 initializing the random number function is not placed 
C         in the input stream until several stages into a trajectory and 
C         random numbers have been utilized, the duplication of the exact 
C         run is not guarenteed even with the same random number seed, 
C         due to those stochastic variables set prior to random number   
C         initialization.
C
C
C
          IF( VR(2) .EQ. 0 ) THEN 
C
C             Call ranset once at the beginning of the entire CADAC 
C             run and use  seed = VR(1) // "01"
C
              IF( SEEDFLAG .NE. 1 ) THEN
C
C                Even if monte carlo/multi-run cases are being executed, 
C                the seed initialization will only be performed once.
C
                 ISEED = RANSEED
                 CALL SETRANDSEQ( ISEED )    ! Start a new RV sequence.
                 SEEDFLAG  = 1
C                                
                 IF( RANVAR ) THEN
C
C                    Only write the message if requrested by user.
C                    (Added by request of Dr. Zipfel - Dec 93 )
C           
                     WRITE(ID_TABOUT,*)
                     WRITE(ID_TABOUT,*) 
     1                ' RANDOM SEED INITIALIZATION: SEED=', ISEED
                     WRITE(ID_TABOUT, *)
C                     
                 ENDIF
C
              ENDIF
C
          ELSEIF( VR(2) .EQ. 1 ) THEN 
C
C             The input card was encountered on the input deck.  
C             Initialize the seed as requested using  seed = VR(1).
C             This was modified Aug 93 (see modif. note at top of code)
C
              INSEED = RANSEED
              ISEED = ( INSEED * 100 ) + 1
C
              CALL SETRANDSEQ( ISEED )    ! Start a new RV sequence.
C
C
                 IF( RANVAR ) THEN 
C
C                    Only write the message if requrested by user.
C                    (Added by request of Dr. Zipfel - Dec 93 )
C           
                    WRITE(ID_TABOUT,*)
                    WRITE(ID_TABOUT,*)
     1                ' RANDOM SEED INITIALIZATION: SEED=', ISEED
                    WRITE(ID_TABOUT,*) 
     1               ' ENTER SEED = ', INSEED, ' TO RE-RUN TRAJECTORY' 
                    WRITE(ID_TABOUT,*)
                 ENDIF
C
           ELSE 
C
              NORUN = JRUN 
C
              IF( VR(2) .NE. 2 ) THEN               
                  NOGROUP = 1               ! VR(2) = 3
              ELSE
                  NOGROUP = IGROUP          ! VR(2) = 2
              ENDIF
C
              CALL CAD_SEEDCALC( ISEEDVAL, NORUN, NOGROUP )
              INSEED = ( ISEEDVAL / 100 ) 
              ISEED = ISEEDVAL 
C   
              CALL SETRANDSEQ( ISEED )    ! Start a new RV sequence.
C
                 IF( RANVAR ) THEN 
C
C                    Only write the message if requrested by user.
C                    (Added by request of Dr. Zipfel - Dec 93 )
C           
                    WRITE(ID_TABOUT,*)
                    WRITE(ID_TABOUT,*)
     1                ' RANDOM SEED INITIALIZATION: SEED=', ISEED
                    WRITE(ID_TABOUT,*)
     1                ' ENTER SEED = ', INSEED, ' TO RE-RUN TRAJECTORY' 
                    WRITE(ID_TABOUT,*)  
C                    
                 ENDIF
C
           ENDIF
C
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE C3_STOC_SET( IR2, ALPHA3, VR )
C
C-------------------------------------------------------------------------
C
C--Argument List Definitions-------------------------------------------
C
C  IR2    - (I) Input.  The C element number of the variable being set.
C  ALPHA3 - (C) Input.  The character string containing the 
C               user-selected type for the stochastic variable. 
C  VR(2)  - (R) Input. The real data values entered on the type 3 card. 
C               The definition of these variables is dependant on the 
C               type of stochastic variable entered in ALPHA3.
C
C-------------------------------------------------------------------------
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /OPFLAG/ INTMSG, STGMSGOUT, INECHO, XSWEEP
      LOGICAL         INTMSG, STGMSGOUT, INECHO, XSWEEP
C
C
      COMMON  C(3510)
C
      DIMENSION VR(2)     
      CHARACTER ALPHA3*6
C
C 
C     Calculate the flags for detecting the selected variable type.
C     NOTE:  this may not be the most effective programming (ie in terms 
C     of computer time) but does give clear coding (easy to read) and 
C     is easy to mod to add more variable types.
C
      IUNIF   = INDEX( ALPHA3, 'UNIF'   )
      IGAUSS  = INDEX( ALPHA3, 'GAUSS'  )
      IEXPO   = INDEX( ALPHA3, 'EXPO'   )
      IRAYLEI = INDEX( ALPHA3, 'RAYLEI' )
      ISIGN   = INDEX( ALPHA3, 'SIGN'   )
      IEQUALS = INDEX( ALPHA3, 'EQUALS' )
C
C
      IF( IUNIF .GT. 0  ) THEN 
C
C---    Uniform random variable selected.
        C( IR2 ) = UNIF( VR(2), VR(1) )
C
      ELSEIF( IGAUSS .GT. 0  ) THEN
C
C---    Gaussian random variable selected.  
        IF( VR(2) .NE. 0.0 ) C( IR2 ) = GAUSS( VR(2), VR(1) )
C
      ELSEIF( IEXPO .GT. 0 ) THEN
C
C---    Exponential random variable selected.  
        IF( VR(1) .GT. 0.0 ) C( IR2 ) = EXPON( VR(1) )
C
      ELSEIF( IRAYLEI .GT. 0 ) THEN
C
C---    Rayleigh random variable selected.  
        IF( VR(1) .GT. 0.0 ) C( IR2 ) = RAYLEIGH( VR(1) )
C
      ELSEIF( ISIGN .GT. 0 ) THEN
C
C---    Sign function selected for variable determination.
        C( IR2 ) = SIGNFUNCT( VR(1) )
C
      ELSEIF( IEQUALS .GT. 0 ) THEN
C
C---    The Equal function selected for the variable 
C---    initialization.  Set this variable equal the current value 
C---    of a user selected C element.
        IELEMENT = INT( VR(1) )
        C( IR2 ) = C( IELEMENT )
C
      ELSE
C
C---    An error has occurred:  The Alpha3 variable is non-blank
C---    but the text did not match the required function names.
        WRITE(ID_TABOUT,*)
        WRITE(ID_TABOUT,*)
     1      ' ERROR ON TYPE 3 CARD - INVALID FUNCTION NAME:'
        WRITE(ID_TABOUT,*) ' Variable num, Function Name: ', IR2, ALPHA3
        WRITE(ID_TABOUT,*) 
C
        C( IR2 ) = VR(1) 
C
        IF( RANVAR) WRITE(ID_RANVAR,*)
     1  ' ERROR ON TYPE 3 CARD - INVALID FUNCTION NAME:'
C
      ENDIF
C
C
C---  Record to RANVAR.ASC the actual RANDOM values selected for the 
C---  stochastic variables.
      IF( RANVAR ) WRITE( ID_RANVAR, *) IR2, ' ', ALPHA3, C(IR2)
C
C
      RETURN
      END
      SUBROUTINE CAD_SEEDCALC( ISEEDVAL, NORUN, NOGROUP )
C
C-------------------------------------------------------------------------
C
C   This module generates a random number seed based on the value in 
C   RANSEED (C(0090)), NORUN and NOGROUP.  
C   This module was modified Aug 93 due to a problem with reading a 
C   number with more than 7 digits from the input deck.  The 32 bit VAX 
C   only keeps 7 sig digits for a REAL variable ( this field is read real 
C   then converted to integer).  Problems specifing a Seed with more than 7 
C   digits.  BUT a seeds must differ by 10000 between consec. runs/groups to 
C   produce a first value that is uniform.  Therefore try to allow the 
C   user to enter the upper 7 digits and add '01' to the end (least sig) of 
C   the number.
C  
C--Argument List Definitions-------------------------------------------
C
C  ISEEDVAL - (I) Output.  The seed value calculated by this module.
C  NORUN    - (I) Input. The current trajectory run number.
C  NOGROUP  - (I) Input.  The current trajectory group number.
C
C-------------------------------------------------------------------------
C  
      COMMON          C(3510)
C 
      EQUIVALENCE (C(0090), RANSEED )
C
C
C---  Calculate the random number seed:
C     NOTE:  The random number seed is an integer and must be odd.
C            Consecutive (even then odd) values produce the same
C            random number sequence.
C
      IRANSEED = INT( RANSEED ) * 100
C
C     Insure the number is odd and apply the run and group numbers.
C
      IADDVALUE = ( NORUN * 1000000 ) + ( NOGROUP * 10000 ) + 1
C
C     Therefore the final result will be odd
C      
      ISEEDVAL = IRANSEED + IADDVALUE 
C
C
      RETURN
      END
      SUBROUTINE EXEC
C
C-------------------------------------------------------------------------
C  
C  This module opens the scratch files: IMPACT7.ASC and IMPACT10.ASC;
C  opens and reads the Head.ASC, loading the scroll variable arrays 
C  and the plot variable arrays, then closes the file;  and provides the 
C  control for the CADAC simulations under multi-run conditions.  
C  Re-initializing the C variable from tape 90 is also performed in this 
C  module.
C
C--Local Variable Definitions-------------------------------------------
C
C INITSUBS - (I) Flag: 0= Beginning of the trajectory - Execute the 
C            initialization modules; 1= Middle of trajectory - Skip the 
C            initialization modules.  Istage cannot be used for this 
C            because it is modified by the input.
C NPLOTVAR - (I) The number of plot variables selected on the HEAD.ASC 
C            file by the user.
C
C-------------------------------------------------------------------------
C
C---  Storage locations for exec are 50-99
C
C
      COMMON           C(3510)
C 
      COMMON /CCOM/    ICF(25), ICC(25), ICL(25), CA(25), 
     1                 CL(25), CT0(25), NC, ICL2(25)
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /FIRSTI/ FINIT
      LOGICAL FINIT
C
      COMMON /FLAG1/   INITGAUSS
      LOGICAL          INITGAUSS
C
      COMMON /KRUN/    JRUN, MULRUN, IGROUP
C
      COMMON /NAD/     IBEEN, IBEGIN, ICARD, ISAVE
C
      COMMON /OINDAT/  J16, ICD, I16
C
      COMMON /OPFLAG/ INTMSG, STGMSGOUT, INECHO, XSWEEP
      LOGICAL         INTMSG, STGMSGOUT, INECHO, XSWEEP
C
      COMMON /PREV/    TPREV, CPPREV, PPPREV
C
      COMMON /STAGE1/  ISTAGE, NUMSTAGE
C
      COMMON /STAGEC/  NAME1(2), NAME2(2)
      CHARACTER        NAME1*6, NAME2*6
C
      DIMENSION  DER(101), V(101)  
C
C
      EQUIVALENCE (C(1801), CRITNO  )
      EQUIVALENCE (C(1802), CRITVAL )
      EQUIVALENCE (C(2000), TIME    )
      EQUIVALENCE (C(2006), ITAP90  )
      EQUIVALENCE (C(2662), HMIN    )
      EQUIVALENCE (C(2663), HMAX    )
      EQUIVALENCE (C(2664), DER(1)  )
      EQUIVALENCE (C(2561), NIP     )
      EQUIVALENCE (C(2765), V(1)    )
      EQUIVALENCE (C(2011), KSTEP   )
      EQUIVALENCE (C(2285), NJ      )
      EQUIVALENCE (C(2280), NV      )
      EQUIVALENCE (C(2001), TSTAGE  )
      EQUIVALENCE (C(2016), PGCNT   )
      EQUIVALENCE (C(2020), LCONV   )
      EQUIVALENCE (C(2866), ICOOR   )
C
C
C      CHARACTER FILENAME*50
C      INTEGER GETENVQQ
      LOGICAL FLAG13
C
C      DATA C/ 3510 * 0.0 /
C
C
C
C---  Open and process the Head.ASC file information.
      CALL RDH1_HEADR( NPLOTVAR )
C
C
C---  Open the output files and start the tabular output by writing the
C---  title, variable headings, etc.
      CALL OP_START( NPLOTVAR )
C
C
C---  Read the input card and load the card data into the modules
      CALL RDI1_INIT_CARDS 
C
C
C
  520 CONTINUE
C
C
C---  Perform a write to the RANVAR output file (if it is requested)
C     to assist in finding variables assignments used in multi-run
C     cases
C
      IF( RANVAR )
     1WRITE(ID_RANVAR,*) ' IGROUP = ', IGROUP, '  JRUN = ', JRUN
C
C---  Very beginning of a trajectory calculation.  
C     This section is the initialization of both Local and  EXEC common 
C     variables.
C
      INITGAUSS = .FALSE. 
C
      NC       = 0
      NUMSTAGE = 0    ! Stage counter.
      J16      = 0    ! Flag: pull data from main trajectory arrays.
      ICD      = 0    ! Main trajectory card counter.
      ISTAGE   = 0
      INITSUBS = 0
      TSTAGE   = 0.0
      TPREV    = 0.0
C
C---  Initialize the C array to zeros:
C
      CALL SET_C_ZERO
C
C---  Setup a default critical value and variable for the non-sweep 
C---  runs.   The input deck for sweep runs will reset these variables
C---  to the proper values.  The default variable for the non-sweep
C--   cases is DHJ = 1773.
C
      CRITNO = 1773 
      CRITVAL = 0.00001 
C
C     Initialize the max and min plot variable arrays.
C
      CALL INI1_PMIN
C
C---  Re- Initialize the common location that contains the number of 
C---  variables in the plot list since this value has been zero-ed out
C---  by the above loop.
      NV = NPLOTVAR 
C
C     Initialize the flag which indicates the action of the EXEC after
C     each integration loop.
C
      KSTEP   = 1
C
C     Initialize several earth and conversion variables.
C
      CALL INI1_VARS 
C
C
C
      IF( ISAVE .GT. 0 ) THEN
C
C         Data has been saved to a tape 90.  Read the data from the 
C         tape.
C
          CALL RD_TAPE90
C
C         Type 90 cards must occur after a stage.  Set the flags
C         to inhibit re-entry into the initialization modules
C         when a simulation is being restored.
C
          ISTAGE   = 16
          INITSUBS = 1
C
C         Set the C variable that indicates when a trajectory is being
C         restarted from a type 90 save; This is set to 0 above (when
C         the C array is initialized)
C
          ITAP90 = 1
C
C         Call the D3I initialization module.  This facilitates the 
C         sweep cases that "start" from a type 90 save.  This ITAP90 
C         variable is used within D3I to inhibit initialization of 
C         certain variables since this is NOT the beginning of the
C         original trajectory.  This call should not interfere with 
C         Non-sweep cases since the D3I module should be in the "DUMMY"
C         modules because the D1I performs the initialization for 
C         non-sweep cases.  Also, these modules should have IF tests
C         on MINIT to exit if an inappropriate case is being called.
C
C         Changed call to D3I to G1I.
C         Since this is in a section of the program that runs TAPE90 
C         with the SWEEP option.  This setup of a TAPE90 and SWEEP has
C         not been fully checked out and will remain an undocumented
C         feature until it has been checked out.  [BC XR97]
C
C         Changed call to G1I with call SWEEPI since the SWEEP initialization
C         routines are now included in the executive routine CADX.FOR [BC 8 Sep 98]
C
          CALL SWEEPI
C
      ENDIF
C
C
C
  580 CONTINUE
C
C---  This section is where the input cards are processed.  The program
C     executes here at the beginning of each trajectory, and returns 
C     here at the end of each stage to process the next set of stage cards.
C
C
      IF( LCONV .LE. 0  ) THEN
C
C         The trajectory has not reached termination as defined by G4 
C         module.
C
C         Perform the input card processing.
C
          CALL OINPT1 
C
          IF( HMIN .EQ. 0.0 ) HMIN = DER(1)
          IF( HMAX .EQ. 0.0 ) HMAX = DER(1)
C
          IF( INITSUBS .EQ. 0 ) THEN
C
C             This is the start of the trajectory computations. 
C             At this point in the code, the variables have been 
C             initialized and the stage 0 cards have been read 
C             and processed.  
C
C             IF( XSWEEP .AND. MULRUN .EQ. 0 ) THEN
C
C                 A Sweep case is being executed (Not with the multi-run 
C                 mode : type 5 card)  Increment the run counter 
C                 here (instead of in the type 21 card processing 
C                 module {prior XR92} ) to keep the count of the number 
C                 of executed trajectories correct.
C
C                  JRUN = JRUN + 1
C              ENDIF
C
              GOTO 800
C
          ELSE
C
C             In the middle of a trajectory either through a stage
C             or a type 90 card.  Insure some values of the Executive
C             common/control variables.
C
              LCONV = 0
              KSTEP = 1
              PGCNT = 1 
C
              INTEST = NV - 1
              NOPLOT = MIN0( 70, MAX0( 0, INTEST) )
              IF( NOPLOT .GT. 0 )  PPCNT = TIME - 0.000001
C
C             Continue with integration cycle.
C
              GO TO 880 
          ENDIF
C
      ELSE
C
C         The end of the trajectory has occurred.  
C         Read the input until an input card type 6 is found.
C
          DO WHILE ( ISTAGE .NE. 6 )
             CALL OINPT2
          ENDDO
C
          GOTO 1060 
C
      ENDIF
C
C
C
C
  800 CONTINUE
C
C     This section performs module initialization.  
C
C---  Execute the pre-initialization modules for the type 1 card 
C     modules.  NOTE:  Currently no modules defined in this module
C
      CALL SUBL1
C
C
C---  Call the initialization modules for the type 2 card modules. 
C
      ICOOR = -2
C
      CALL AUXI
C
C
C     Set the flag indicating that the initialization modules have been
C     executed for this trajectory.
C
      INITSUBS = 1
C
C
C---  Execute the initialization modules for the type 1 cards:
C     Call the initialization modules for the modules specified on the 
C     input type 1 cards ( OUPT2 and STGE2 )
C
      CALL SUBL2
C
C
C---  Load the V and DER variables from the C array: 
C     Calculate the number if integration variables defined.
C
      N  = MAX0( 2, NIP ) 
C
      CALL LD_DERIV( N )
C
  880 CONTINUE 
C
C     This section controls the execution of the modules and the 
C     integration cycle.
C
C---  Execute the auxillary modules (type 2 card modules )
C
      ICOOR = -1
C
C     Call the modules specified on the type 2 cards.
C
      CALL AUXSUB
C
      IF( FINIT ) THEN
C
C     Call the RT initialization routine if a RT INIT file is to be
C     created
C
        CALL OP3_RTIWRITE
        CALL OP3_RTWRITE
        FINIT = .FALSE.
C
      ENDIF
C
C     Check for stage conditions being met.
C     This call statement was removed so that a redundant call to the stage
C     test routine was not called.  The stage routine is called after each 
C     integration cycle is complete.  This call was made immediately after
C     group cards were loaded or after a previous stage [BC 8 Sep 98]
CBC      ICALL = 1
CBC      CALL STGE3( ICALL )
C
C
      IF( NIP .GT. 100 ) THEN
C
          WRITE(ID_TABOUT,940)
  940     FORMAT( '0------ TOO MANY STATE VARIABLES. ', 
     1                         'RUN ABORTED. ------' )
C         Read the input until an input card type 6 is found.
C
          DO WHILE ( ISTAGE .NE. 6 )
             CALL OINPT2
          ENDDO
C
          GOTO 1060 
      ENDIF
C
C
C
  960 CONTINUE
C
C
C---  Execute the integration modules.
C
      N = MAX0( 2, NIP ) 
      N = MIN0( N, 100 )
C
      NJ = N - 1        ! Used in AMRK module
C
      CALL AMRK
C
C
C---  Shift the data produced by the integration arrays into the C arrays.
C
      CALL LD_CARRAY( N )
C
C
C---  Execute the card type 1 modules.
C
      CALL SUBL3
C
C
C---  Check the status of the integration cycle:
C
      IF( KSTEP .EQ. 1 ) THEN
C
C         No change in status - Continue the integration cycle.
C
          GOTO 960 
C
      ELSEIF( KSTEP .EQ. 2 ) THEN  !zzzz
C
C         End of trajectory detected - Read the input until an input 
C         card type 6 is found (incase not already at a type 6 card)
C
          DO WHILE ( ISTAGE .NE. 6 )
             CALL OINPT2
          ENDDO
C
C---  Call STGE3 to write data to SWEEP files at end of total miss trajectory
C
          IF( LCONV .EQ. 5 ) THEN
              ICALL = 1
              CALL STGE3( ICALL )
          ENDIF
C
      ELSEIF( KSTEP .EQ. 3 ) THEN 
C
C         The current stage requirements have been met.
C
          GOTO 580 
C
      ENDIF
C
C
C
C
 1060 CONTINUE
C
C---  This section controls execution when the end of the trajector has 
C---  been detected.
C
C
C---  Reset control flags
      KSTEP = 1
      LCONV = 0
      TPREV = 0.0
C
C---  Zero the integration array.
      DO JV = 2, N
         V(JV) = 0.0  
      END DO
C
C
C---  Check for special execution cases:
C
C
      IF( XSWEEP ) THEN
C
C---       A sweep case is being executed and a trajectory has 
C---       completed.
C
C---       Write the final trajectory data to the TRAJ.* file: ie the 
C---       -1.0 record and the max data record.
           IF( TRAJBIN ) THEN
             IUNIT = ID_TRAJBIN
             CALL OP3_PF11( IUNIT ) 
           ENDIF
           IF( TRAJASC ) THEN
             IUNIT = ID_TRAJASC
             CALL OP3_PF11( IUNIT )
           ENDIF
C
C
           IF( MULRUN .GT. 0   .AND.  JRUN .GE. MULRUN ) THEN 
C
C---           Finished all trajectory runs in the current sweep
C---           position (angle and range setting).  Reset the run 
C---           counter and increment the group counter. 
               JRUN   = 0
               IGROUP = IGROUP + 1
           ENDIF
C
C---       Copy the primary, stored trajectory into the working arrays 
C---       and run the next trajectory sweep.   The card type 18 causes 
C---       the adjustments in the trajectory.   
           CALL WORK
C
C---       Restart for the next trajectory.  Branch to initialization.
           JRUN = JRUN + 1
           GOTO 520
C
      ENDIF
C
C
C---  Write the final trajectory data to the trajectory file: ie the 
C---  -1.0 record and the max data record.
      IF( TRAJBIN ) THEN 
        IUNIT = ID_TRAJBIN
        CALL OP3_PF11( IUNIT ) 
      ENDIF
      IF( TRAJASC ) THEN
        IUNIT = ID_TRAJASC
        CALL OP3_PF11( IUNIT )
      ENDIF        
C
C
      IF( MULRUN .GT. 0 ) THEN
C
C---      Multi-run trajectory case: 
C---      If the run counter is less than the maximum number of runs 
C---      to be perform, then increment run counter and go perform another 
C---      trajectory run.  Branch to the trajectory initialization.
          IF( JRUN .LT. MULRUN ) THEN
              JRUN = JRUN + 1 
              GOTO 520 
          ENDIF
C
C---      Else - Finished all runs in the multi-run case.  Reset the run 
C---      counter.  Reset the read from CSAVE.ASC file to indicate start
C---      of new group trajectory
C
          JRUN   = 1
          ISAVE = 0
C
      ENDIF
C
C---  Trajector(y/ies) for this base card set completed.  Continue 
C---  reading the file to determine if group cards exist, and if so, process 
C---  these trajectories.
C
C---  Increment the group counter.
      IGROUP = IGROUP + 1
C
C---  Copy the primary trajectory to the working arrays, 
C---  read the lead card deck for the cards in the next group and 
C---  modifies/add them to the primary trajectory accordingly.
      CALL RDI2_GROUP( FLAG13 ) 
C
C---  If a card type 13 has not been read (or abnormal end of file 
C---  reached), then a type 12 card at the end of a group card set 
C---  was detected.  Go compute this trajectory.
      IF( .NOT. FLAG13  ) GOTO 520
C
C
C---  A type 13 card was encountered in the input stream.
C     End of simulation:  write the ending records to the trajectory file
C---  and statistics files. Then close the files.
C---  NOTE: Since converted from MS PowerStation 4.0 to Digital Visual FORTRAN
C           the ENDFILE statement was replaced with the CLOSE statement to 
C           correctly disassociate the unit ID from the file without errors
C           for binary files. (The error was produced b/c the file was not opened
C           as a sequential file ?)   [BC 26 May 98]
C
      IF( STATBIN ) THEN
        IUNIT = ID_STATBIN
        CALL OP3_PF11( IUNIT )
        CLOSE( ID_STATBIN )
      ENDIF
      IF( STATASC ) THEN
        IUNIT = ID_STATASC
        CALL OP3_PF11( IUNIT )
        CLOSE( ID_STATASC )
      ENDIF
C
C---  The end records have already been recorded to the trajectory file.
      IF( TRAJBIN )  CLOSE( ID_TRAJBIN )
      IF( TRAJASC )  CLOSE( ID_TRAJASC )
      IF( TRACKBIN ) CLOSE( ID_TRACKBIN )
      IF( TRACKASC ) CLOSE( ID_TRACKASC )
C 
      STOP 
      END
      SUBROUTINE SET_C_ZERO
C
C-------------------------------------------------------------------------
C  
C  This module initializes all elements of the C array to zero. 
C
C--Local Variable Definitions-------------------------------------------
C
C  I - (I) DO loop counting variable to increment through all of the C 
C          array elements.
C
C-------------------------------------------------------------------------
C  
      COMMON  C(3510)
C 
C
      DO I = 1, 3510
         C(I) = 0.0
      ENDDO
C
C
      RETURN
      END
      SUBROUTINE SWP_6PRINT( IRUN )
C
C-------------------------------------------------------------------------
C
C  This module prints data to the tabular output file, unit 6.
C
C--Argument List Definition---------------------------------------------
C
C  IRUN - (I) The trajectory number of the inner loop.
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C***  Input
C
      EQUIVALENCE (C(1800), ISWEEP )
      EQUIVALENCE (C(1811), ANGLNO )
      EQUIVALENCE (C(1821), RANGNO )
C
C ISWEEP = Flag: 0 = no sweep; 1n : n = sweep option
C ANGLNO = The C element number for the outer variable.
C RANGNO = The C element number for the inner variable.
C
C
C---  Convert the inner loop variable to integer.
      IRANGNO = RANGNO
C
C---  Print the data to the tabular output file.
      WRITE(ID_TABOUT,1340) 
     1     IRUN, C(INT(ANGLNO)), C(INT(RANGNO)), ISWEEP, IRANGNO
C
 1340 FORMAT( /1X, 'RUN # ', I3, ' OUTER= ', G12.5, 'INNER= ', 
     1        G12.5, ' OPT #= ', I3, 
     2        ' INNER VAR #= ', I5 )
C
C
      RETURN
      END
      SUBROUTINE SWP_7DATA( NDATA )
C
C-------------------------------------------------------------------------
C
C  This module transfers NDATA records of NV data from the unit 7 
C  scratch file, to the tape 22 file.  
C
C-------------------------------------------------------------------------
C
      DIMENSION PDATA(70)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON C(3510)
C
C***  Input from other modules
C
      EQUIVALENCE (C(2280), NV )
C
C
C---  NOTE:  The for007 file is assummed to already be open and written
C---  to.  The Swp_runinit opens the file and the STGE3 module writes to 
C---  the file when the trajectory generates a miss distance/pca.
C---  Read and transfer the data written to the file.
      REWIND ( ID_IMPACT7 )
      DO I = 1, NDATA
         READ(ID_IMPACT7,*,END=100)   ( PDATA(J), J=1, NV )
         WRITE(ID_IMPACT,*) ( PDATA(J), J=1, NV )
      ENDDO
C
C
  100 CONTINUE
C
C
C---  Close the file, then re-open the file in preparation of the next 
C---  trajectory.  The file is closed (instead of rewound) so that if
C---  the trajectory is not normally terminated, the file will be empty
C---  and invalid data will not be transfered to unit ID_IMPACT.
      CLOSE( ID_IMPACT7, STATUS = 'DELETE' ) 
C---      PRINT *, 'FILENAME:', FILENAME(1:LENSTR(FILENAME))
      OPEN( UNIT=ID_IMPACT7,  FILE='IMPACT7.ASC',  STATUS='UNKNOWN' )
C
C
      RETURN
      END
      SUBROUTINE SWP_7DATA45( NDATA, IPOS )
C
C-------------------------------------------------------------------------
C
C  This module transfers NDATA records of NV data from the unit 7 
C  scratch file, to the tape 22 file.  Called only from SWEEP4 and
C  SWEEP5 Methodology.  Created under XR97.
C
C-------------------------------------------------------------------------
C
      DIMENSION PDATA(70), IPOS(100)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON C(3510)
C
C***  Input from other modules
C
      EQUIVALENCE (C(2280), NV )
C
C
C---  NOTE:  The for007 file is assummed to already be open and written
C---  to.  The Swp_runinit opens the file and the STGE3 module writes to 
C---  the file when the trajectory generates a miss distance/pca.
C---  Read and transfer the data written to the file in ascending range order.
      REWIND ( ID_IMPACT7 )
      DO I = 1, NDATA
         DO J = 1, IPOS( I )
            READ(ID_IMPACT7,*,END=100)   ( PDATA(K), K=1, NV )
         ENDDO
         WRITE(ID_IMPACT,*) ( PDATA(K), K=1, NV )
         REWIND (ID_IMPACT7 )
      ENDDO
C
C
  100 CONTINUE
C
C
C---  Close the file, then re-open the file in preparation of the next 
C---  trajectory.  The file is closed (instead of rewound) so that if
C---  the trajectory is not normally terminated, the file will be empty
C---  and invalid data will not be transfered to unit ID_IMPACT.
      CLOSE( ID_IMPACT7, STATUS = 'DELETE' ) 
      OPEN( UNIT=ID_IMPACT7,  FILE='IMPACT7.ASC',  STATUS='UNKNOWN' )
C
C
      RETURN
      END
      SUBROUTINE SWP_CRITCHECK
C
C-------------------------------------------------------------------------
C
C  This module performs a check on the criteria maximum value, CRITMAX, 
C  C(1805).  This module was added during task XR92.
C
C  At the beginning of each sweep trajectory, the C array is init. to 
C  0.0.  Then the stage 0 cards are processed.  If the CRITMAX value is NOT 
C  initialized by a type 3 card, the location contains a 0.0 value; else 
C  the location will contain the value entered by the user.  This module
C  checks the CRITMAX variable and if it contains a value less than the 
C  CRITVAL (minimum critical value), then the CRITMAX is initialized to be 
C  equal to CRITVAL + 9.0E+05.
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C***  Input
C
      EQUIVALENCE (C(1802), CRITVAL )
      EQUIVALENCE (C(1805), CRITMAX )
C
C CRITVAL = The minimum critical value for the criteria test.
C CRITMAX = The maximum critical value for the criteria test.
C
      LOGICAL  PRINTMSG   /.FALSE./
C
C
      IF( CRITMAX .LE. CRITVAL ) THEN 
C
C---    The maximum critical value is not a valid value.  
C---    Modify the CRITMAX:
C       Default CRITMAX to 0.0 [bc 24 Spet 98]
CBC        CRITMAX = CRITVAL + 9.0E+05
        CRITMAX = 0.0
C
        IF( PRINTMSG ) THEN
C
C---      Print an error message if maximum critical value is being changed.
          WRITE(ID_TABOUT,*) ' '
          WRITE(ID_TABOUT,*) 
     1      ' ***MAXIMUM CRITICAL VALUE BEING MODIFIED***'
          WRITE(ID_TABOUT,*) '    CRITMAX = 0.0   '
          WRITE(ID_TABOUT,*) ' '
C
          PRINTMSG = .FALSE. 
C          
        ENDIF
C
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE SWP_DATCHK( RANSAVE, GOODAT, CRITDAT )
C
C-------------------------------------------------------------------------
C
C   This module reads the impact10 scratch file and checks the range data
C   against the current range data.  If the ranges match to within a
C   set tolerance, the GOODATa flag is set TRUE and the value of the
C   critical variable calculated for the range is returned.  If the
C   ranges do not match (traj was stopped by the program or the 
C   trajectory was a 'miss'), then the gooddata flag is set FALSE.
C
C--Local Variable Definitions---------------------------------------------
C
C  KRIT  - (I) Pointer into the RDATA array to the criteria data. 
C  NV10  - (I) The number of variables writted to the scratch file by 
C          module STGE3.  The max number of variables in RDATA
C  RDATA(3) - (R) Array of data generated at the end of the sweep runs.
C
C-------------------------------------------------------------------------
C
      LOGICAL GOODAT
C
      DIMENSION RDATA(3)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      DATA KRIT/ 1 /, KVAR1/ 2 /, NV10/ 3 /
C
C
C---  Rewind the scratch and read the results of the latest trajectory.
C
      REWIND (ID_IMPACT10)
      READ(ID_IMPACT10,*) ( RDATA(I), I=1, NV10 )
C
C
C     Test the data to insure that the trajectory resulted in valid criteria
C     being printed to the file.  This tolerance test was implemented 
C     APR 92 when problems occurred.  Rdata and Ransave tested different 
C     when they were supposed to be the same.  The differences resulted
C     from computer representation and the changes in the RDATA number 
C     due to being written to the file, then read. 
C
      TESTVALUE = ABS( RDATA(KVAR1) - RANSAVE ) 
C
      IF( TESTVALUE .GT. 0.01 ) THEN 
C
C         The previously generated trajectory did not produce criteria 
C         data.  The trajectory was halted prior to the tape 10  & 7 
C         writes due to other reasons.  Back up toward the previous 
C         "good" data
C
           GOODAT = .FALSE.
C
      ELSE
C
C         Valid criteria data was written to the tapes 10 & 7. 
C
          GOODAT = .TRUE.
C
C         Extract the criteria variable value calculated by the run
C         for testing in the calling module. 
C
          CRITDAT = RDATA( KRIT ) 
C
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE SWP_DO_SORT( NREC )
C
C----------------------------------------------------------------------
C
C     This module performs a BUBBLE sort on the IMPACT7.ASC file to 
C     make sure the data written to the IMPACT.ASC file is in the
C     correct order: increasing range, increasing angle.
C
C--Argument List Definitions-------------------------------------------
C
C  NREC         - (I) Number of trajectories on the IMPACT7.ASC file
C
C--Local Variable Definitions------------------------------------------
C
C  IPOS(100)    - (I) The array of trajectories in ascending range
C                 order
C  IRANGE       - (I) The array location in the plot variable list of
C                 the inner (range) variable
C  ITEMPOS      - (I) Temp trajectory number during bubble sort
C  PDATA(70)    - (R) The trajectory data written to scratch by module 
C                 STGE3.  This data contains the criteria data value, the 
C                 inner variable and the outer variable for that trajectory.
C  RSORTED(100) - (R) Array of sorted range values in ascending order
C  TEMPR        - (R) Temp Range value during bubble sort
C
C----------------------------------------------------------------------
C
      COMMON C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /OPPLOT/  IPLADD(70), INTPLOT(70)
      LOGICAL          INTPLOT
C
      COMMON /OPPLTC/  ALABLE
      CHARACTER        ALABLE(70)*8
C
C***  Input Data
C
      EQUIVALENCE (C(1821), RANGNO )
      EQUIVALENCE (C(2280), NV     )
C
C      NV = The number of plot variables on the output files
C      RANGNO = The C element number of the inner variable
C
      DIMENSION PDATA(70), RSORTED(100), IPOS(100)
C
C     Rewind the IMPACT7.ASC file to ensure reading from the beginning
      REWIND ( ID_IMPACT7 )
C
C---  Determine the Range position in the plot variables
      DO I = 1, 70
C
        IF( IPLADD( I ) .EQ. INT( RANGNO ) ) THEN
            IRANGE = I
        ENDIF
C
      ENDDO
C
C---  Read the range values into the sorted array
      DO J = 1, NREC
C
        READ(ID_IMPACT7,*, END = 100) (PDATA(N), N=1, NV )
        RSORTED( J ) = PDATA( IRANGE )
        IPOS( J )    = J
C
      ENDDO
C
C---  Sort the range array
  100 DO K = (NREC-1),1,-1
C
         DO L = 1, K
C
            IF( RSORTED( L ) .GT. RSORTED( L + 1 ) ) THEN
                TEMPR            = RSORTED( L )
                RSORTED( L )     = RSORTED( L + 1 )
                RSORTED( L + 1 ) = TEMPR
                ITEMPOS           = IPOS( L )
                IPOS( L )        = IPOS( L + 1 )
                IPOS( L + 1 )    = ITEMPOS
            ENDIF
C
         ENDDO
C
      ENDDO
C
C     Transfer the data from file 7 (IMPACT7.ASC)
C     to file 22 (IMPACT.ASC)
      CALL SWP_7DATA45( NREC, IPOS )
C
      RETURN
      END
      SUBROUTINE SWP_END
C
C-------------------------------------------------------------------------
C
C  This module performs the shutdown procedure for the sweep 
C  trajectories
C
C-------------------------------------------------------------------------
C
C
      COMMON /FILEFLG/TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
      LOGICAL         TRAJBIN, TRAJASC, STATBIN, STATASC, TABOUT, 
     1                RANVAR,  INITASC, INITBIN, TRACKASC, TRACKBIN
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C     Finished all trajectories - perform shutdown 
C     prodecures.
C
C     Close the scratch files and the scratch output file.
C
      CLOSE (ID_IMPACT10, STATUS = 'DELETE') 
      CLOSE (ID_IMPACT7, STATUS = 'DELETE')
      CLOSE (ID_IMPACT)
C
C     NOTE:  Since these file are stopped by the modules and not the
C     executive, at this point, the data in the PMIN array is the 
C     initial search values; Pmin contains 9999.9E38.  To prevent this
C     invalid data from causing problems with other programs, the last 
C     -1.0 and max records are not going to be printed to the TRAJ.* 
C     and STAT.* plot files.  This will not cause any problems with the 
C     IPLT, etc series since they are always checking for EOF anyway. 
C---  NOTE: Since converted from MS PowerStation 4.0 to Digital Visual FORTRAN
C           the ENDFILE statement was replaced with the CLOSE statement to 
C           correctly disassociate the unit ID from the file without errors
C           for binary files. (The error was produced b/c the file was not opened
C           as a sequential file ?)   [BC 29 Sept 98]
C
C
      IF( STATBIN ) CLOSE ( ID_STATBIN )
      IF( STATASC ) CLOSE ( ID_STATASC )
      IF( TRAJBIN ) CLOSE ( ID_TRAJBIN )
      IF( TRAJASC ) CLOSE ( ID_TRAJASC )
C
C 
      STOP ' '
      END
      SUBROUTINE SWP_FINDMISS( JGOOD, NEXTOV, NEXTSR )
C
C-------------------------------------------------------------------------
C
C  Read the scratch file (unit 10) and load the final data from the 
C  trajectories into the CDATA array.  Search the CDATA array for the 
C  boundary from less than the user-entered critical value to greater 
C  than this critical value.  NOTE:  This search assumes that the 
C  trajectories near the maximum produced less-than-critical values and 
C  trajectories near the minimum produced greater-than-critical values. 
C  
C--Argument List Definitions---------------------------------------------
C
C  JGOOD - (I) The trajectory number that produced a non-zero PCA.
C  NEXTOV - (L) Flag:  .FALSE. = The search criteria was satisfied - 
C           start the binary search.  .TRUE. = Data satisfying the 
C           criteria was not found - Increment to the next outer 
C           variable. 
C  NEXTSR - (L) Flag:  .TRUE. = The search critieria was satisified
C            continue the binary search.  .FALSE. = Data did not meet
C           search criteria continue along ray.  This flag is only used
C           for SWEEP5 methodology.
C
C--Local Variable Definitions--------------------------------------------
C
C  KRIT   - (I) Pointer into the RDATA array to the Criteria value.
C  ICOUNT - (I) Counter for the number of miss distances read into the 
C           FMISS array.
C  NV10   - (I) The number of variables printed to the scratch file by 
C           module STGE3.  The max number of variables in RDATA.
C  CDATA(70)  - (R) Array of criteria variable data produced by the 
C               trajectory calculations and saved to the tape 10 file.
C  RDATA(3) - (R) Array of data generated at the end of the sweep runs.
C
C-------------------------------------------------------------------------
C
      LOGICAL NEXTOV, NEXTSR
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C***  Input
C
      EQUIVALENCE (C(1802), CRITVAL )
      EQUIVALENCE (C(1805), CRITMAX )
C
C CRITVAL = The minimum critical value for the criteria test.
C CRITMAX = The maximum critical value for the criteria test.
C
C
      DIMENSION  CDATA(70), RDATA(3)
C
      DATA KRIT/ 1 /, NV10/ 3 /
C
C
C---  Start searching at the beginning of the scratch file.
      REWIND (ID_IMPACT10)
C
C---  Initialize the Trajectory counter.
      ICOUNT = 0
C
C
C---  Read until end of scratch file.   Collect the criteria values.
 1060 CONTINUE
C
C---  Read the data from the file.
      READ(ID_IMPACT10,*,END=1080) ( RDATA(I), I=1, NV10 ) 
C
C---  Increment record/trajecory counter
      ICOUNT = ICOUNT + 1
C
      IF( ICOUNT .EQ. 70 ) THEN 
C
C---    Counter reached maximum array limits.  Produce error message 
C---    and stop execution.
        WRITE(ID_TABOUT,*) 
        WRITE(ID_TABOUT,*) ' *** ERROR - NOT ENOUGH ARRAY ELEMENTS ',
     1                'FOR CRITERIA VALUES *** '
        WRITE(ID_TABOUT,*) 
C
        STOP ' '
      ENDIF
C
C---  Extract the criteria values from the data and load it into the 
C---  search array.
      CDATA( ICOUNT ) = RDATA( KRIT )
C
C---  Go get the next record from the scratch file.
      GOTO 1060
C
C
C---  End of IMPACT10 file.
C
 1080 CONTINUE
C
C     Now - search the array of data to find the trajectory 
C     number that produced the desired transition 
C
C     Initialize the flags:
C
      JGOOD = 1
      NEXTOV = .TRUE. 
C
C     Search BACKWARDS through the data. 
C     Look for data greater than the critical value.    ******
C
      DO I = ICOUNT, 1, -1
C
         IF( CDATA(I) .GT. CRITVAL ) THEN
C
C   This second test option was removed since CRITMAX could be 
C   defaulted to 0.0 [BC 24 SEPT 98]
C  .AND. CDATA(I) .LT. CRITMAX ) THEN
C
C            Found the first data satisfying the criteria.  
C            Set flags and stop search.
C
             JGOOD = I         ! Save the trajectory number.
             NEXTOV = .FALSE.  ! Set the flag.
             NEXTSR = .TRUE.   ! Set the next bianry search flag for SWEEP5 only
C
             GOTO 1120      ! Stop the search.
          ELSE
             NEXTSR = .FALSE.
          ENDIF
      ENDDO
C
C
 1120 CONTINUE
C
C
      RETURN
      END
      SUBROUTINE SWP_FINDMISS5( JGOOD, NEXTOV, NEXTSR )
C
C-------------------------------------------------------------------------
C
C  Read the scratch file (unit 10) and load the final data from the 
C  trajectories into the CDATA array.  Search the CDATA array for the 
C  boundary from greater than the user-entered critical value to less 
C  than this critical value.  NOTE:  This search assumes that the 
C  trajectories near the minimum produced less-than-critical values and 
C  trajectories near the maximum produced greater-than-critical values. 
C  This subroutine was added under XR97.
C
C--Argument List Definitions---------------------------------------------
C
C  JGOOD - (I) The trajectory number that produced a non-zero PCA.
C  NEXTOV - (L) Flag:  .FALSE. = The search criteria was satisfied - 
C           start the binary search.  .TRUE. = Data satisfying the 
C           criteria was not found - Increment to the next outer 
C           variable. 
C  NEXTSR - (L) Flag:  .TRUE. = The search critieria was satisified
C            continue the binary search.  .FALSE. = Data did not meet
C           search criteria continue along ray.  This flag is only used
C           for SWEEP5 methodology.
C
C--Local Variable Definitions--------------------------------------------
C
C  KRIT   - (I) Pointer into the RDATA array to the Criteria value.
C  ICOUNT - (I) Counter for the number of miss distances read into the 
C           FMISS array.
C  NV10   - (I) The number of variables printed to the scratch file by 
C           module STGE3.  The max number of variables in RDATA.
C  CDATA(70)  - (R) Array of criteria variable data produced by the 
C               trajectory calculations and saved to the tape 10 file.
C  RDATA(3) - (R) Array of data generated at the end of the sweep runs.
C
C-------------------------------------------------------------------------
C
      LOGICAL NEXTOV, NEXTSR
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C***  Input
C
      EQUIVALENCE (C(1802), CRITVAL )
      EQUIVALENCE (C(1805), CRITMAX )
C
C CRITVAL = The minimum critical value for the criteria test.
C CRITMAX = The maximum critical value for the criteria test.
C
C
      DIMENSION  CDATA(70), RDATA(3)
C
      DATA KRIT/ 1 /, NV10/ 3 /
C
C
C---  Start searching at the beginning of the scratch file.
      REWIND (ID_IMPACT10)
C
C---  Initialize the Trajectory counter.
      ICOUNT = 0
C
C
C---  Read until end of scratch file.   Collect the criteria values.
 1060 CONTINUE
C
C---  Read the data from the file.
      READ(ID_IMPACT10,*,END=1080) ( RDATA(I), I=1, NV10 ) 
C
C---  Increment record/trajecory counter
      ICOUNT = ICOUNT + 1
C
      IF( ICOUNT .EQ. 70 ) THEN 
C
C---    Counter reached maximum array limits.  Produce error message 
C---    and stop execution.
        WRITE(ID_TABOUT,*) 
        WRITE(ID_TABOUT,*) ' *** ERROR - NOT ENOUGH ARRAY ELEMENTS ',
     1                'FOR CRITERIA VALUES *** '
        WRITE(ID_TABOUT,*) 
C
        STOP ' '
      ENDIF
C
C---  Extract the criteria values from the data and load it into the 
C---  search array.
      CDATA( ICOUNT ) = RDATA( KRIT )
C
C---  Go get the next record from the scratch file.
      GOTO 1060
C
C
C---  End of IMPACT10 file.
C
 1080 CONTINUE
C
C     Now - search the array of data to find the trajectory 
C     number that produced the desired transition 
C
C     Initialize the flags:
C
      JGOOD = 1
      NEXTOV = .TRUE. 
C
C     Search BACKWARDS through the data. 
C     Look for data greater than the critical value.    ******
C
      DO I = ICOUNT, 1, -1
C
         IF( CDATA(I) .LT. CRITVAL ) THEN
C  This second test option was removed since CRITMAX could be
C  defaulted to 0.0 [BC 24 SEPT 98]
C .AND. CDATA(I) .LT. CRITMAX ) THEN
C
C            Found the first data satisfying the criteria.  
C            Set flags and stop search.
C
             JGOOD = I         ! Save the trajectory number.
             NEXTOV = .FALSE.  ! Set the flag.
             NEXTSR = .TRUE.   ! Set the next bianry search flag for SWEEP5 only
C
             GOTO 1120      ! Stop the search.
          ELSE
             NEXTSR = .FALSE.
          ENDIF
      ENDDO
C
C
 1120 CONTINUE
C
C
      RETURN
      END
      SUBROUTINE SWP_HALFD( RANSAVE, RANHALF ) 
C
C-------------------------------------------------------------------------
C
C  This module controlls the binary search.  The module checks the data 
C  produced during the last trajectory.  The delta is halved, appropriately 
C  signed, a new inner variable computed and the next trajectory is 
C  setup for calculation. 
C
C--Argument List Definitions---------------------------------------------
C  
C  RANSAVE - (R) The inner loop variable value used in computing the 
C            previous trajectory.
C  RANHALF - (R) The halfed delta; the delta that was used in computing 
C            the previous trajectory and is being halfed during the binary 
C            search.
C
C--Local Variable Definitions---------------------------------------------
C-------------------------------------------------------------------------
C
      LOGICAL GOODAT
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C***  Input
C
      EQUIVALENCE (C(1802), CRITVAL )
      EQUIVALENCE (C(1805), CRITMAX )
C
C CRITVAL = The minimum critical value for the criteria test.
C CRITMAX = The maximum critical value for the criteria test.
C
C
C---  Check to see if the trajectory produced good criteria data.
      CALL SWP_DATCHK( RANSAVE, GOODAT, CRITDAT )
C
C
      IF( .NOT. GOODAT ) THEN 
C
C---      The previously generated trajectory did not produce criteria 
C---      data.  The trajectory was halted prior to the tape 10  & 7 
C---      writes due to other reasons.  Back up toward the previous 
C--       "good" data
          RANHALF = -1.0 * ABS( RANHALF ) * 0.5
C
      ELSE
C
C---      Valid criteria data was written to the tapes 10 & 7. 
C
C---      Test the data to see if it satisfies the criteria; adjust the sign 
C---      appropriately.
          IF( CRITDAT .EQ. CRITMAX ) THEN  ! changed from .GT. to .EQ. [BC 24 SEPT 98]
C
C---          Added under XR97:
C---          The trajectory that produced this CRITDAT did not terminate at
C---          the correct end.  This is actually not good data.  This preserves
C             the SWEEP4 methodology since all data (even a complete miss) is
C             written to the IMPACT7 and IMPACT10 data files.
C---          Set the apprpriate flags and set up the next binarty search run
C---          as if bad data.
              GOODAT = .FALSE.
C
C---          Back up towards the previous good data.
              RANHALF = -1.0 * ABS( RANHALF ) * 0.5
C
          ELSEIF( CRITDAT .LE. CRITVAL ) THEN
C
C---          Critical data variable was less than the critical value
C---          Step back "in" to find a point closer to the critical 
C---          value.
              RANHALF = -1.0 * ABS( RANHALF ) * 0.5
C
          ELSE
C
C---          Critical data variable is greater than the critical value.
C---          Step "out" to find a point closer to the critical value.
              RANHALF = ABS( RANHALF ) * 0.5
C
C---          The data is ASSUMED to hit:  Copy the data for a 
C---          "hit" to the data file.  
C---          NOTE ASSUMPTION:  Always step in from 'miss' and 
C---          out after a 'hit'. (oked with XR - 14 APR 91)
C---          This code was taken out of the loop under XR97:
C---          All trajecotries need to be wriiten to the IMPACT.ASC 
C---          even for complete miss trajectories, thus is this code 
C---          was moved outside this IF loop
C              NDATA = 1
C              CALL SWP_7DATA( NDATA )
C
          ENDIF
C
      ENDIF
C
C---  Write the data to the IMPACT.ASC file whether it was a "hit" or 
C---  "miss"
C     
C---  Comment out this CALL so that all impact data will be written
C---  from IMPACT7.ASC to IMPACT.ASC at the end of each ray after binary
C---  searches.  This done under XR97
C      NDATA = 1
C      CALL SWP_7DATA( NDATA )
C
C     Calculate the new delta.
C
      RANSAVE = RANSAVE + RANHALF 
C
C     During the binomal search, only keep the most current 
C     trajectory results on BOTH the scratch tapes.
C
C---  Comment out this REWIND so that all impact data will be written
C---  from IMPACT7.ASC to IMPACT.ASC at the end of each ray after binary
C---  searches.  This done under XR97
C      REWIND ( ID_IMPACT7 )
      REWIND ( ID_IMPACT10 )
C
C
C     Go calculate the new trajectory.
C
      RETURN
      END
      SUBROUTINE SWP_HALFD5( RANSAVE, RANHALF ) 
C
C-------------------------------------------------------------------------
C
C  This module controlls the binary search.  The module checks the data 
C  produced during the last trajectory.  The delta is halved, appropriately 
C  signed, a new inner variable computed and the next trajectory is 
C  setup for calculation.  This subroutine halves the delta in the opposite
C  direction from that used in SWP_HALFD (added under XR97)
C
C--Argument List Definitions---------------------------------------------
C  
C  RANSAVE - (R) The inner loop variable value used in computing the 
C            previous trajectory.
C  RANHALF - (R) The halfed delta; the delta that was used in computing 
C            the previous trajectory and is being halfed during the binary 
C            search.
C
C--Local Variable Definitions---------------------------------------------
C-------------------------------------------------------------------------
C
      LOGICAL GOODAT
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C***  Input
C
      EQUIVALENCE (C(1802), CRITVAL )
      EQUIVALENCE (C(1805), CRITMAX )
C
C CRITVAL = The minimum critical value for the criteria test.
C CRITMAX = The maximum critical value for the criteria test.
C
C
C---  Check to see if the trajectory produced good criteria data.
      CALL SWP_DATCHK( RANSAVE, GOODAT, CRITDAT )
C
C
      IF( .NOT. GOODAT ) THEN 
C
C---      The previously generated trajectory did not produce criteria 
C---      data.  The trajectory was halted prior to the tape 10  & 7 
C---      writes due to other reasons.  Back up toward the previous 
C--       "good" data
          RANHALF = -1.0 * ABS( RANHALF ) * 0.5
C
      ELSE
C
C---      Valid criteria data was written to the tapes 10 & 7. 
C
C---      Test the data to see if it satisfies the criteria; adjust the sign 
C---      appropriately.
          IF( CRITDAT .EQ. CRITMAX ) THEN   ! changed from .GT. to .EQ. [BC 24 SEPT 98]
C
C---          Added under XR97:
C---          The trajectory that produced this CRITDAT did not terminate at
C---          the correct end.  This is actually not good data.  This preserves
C             the SWEEP4 methodology since all data (even a complete miss) is
C             written to the IMPACT7 and IMPACT10 data files.
C---          Set the apprpriate flags and set up the next binarty search run
C---          as if bad data.
              GOODAT = .FALSE.
C
C---          Back up towards the previous good data.
              RANHALF = -1.0 * ABS( RANHALF ) * 0.5
C
          ELSEIF( CRITDAT .GE. CRITVAL ) THEN
C
C---          Critical data variable was greater than the critical value
C---          Step back "in" to find a point closer to the critical 
C---          value.
              RANHALF = -1.0 * ABS( RANHALF ) * 0.5
C
          ELSE
C
C---          Critical data variable is greater than the critical value.
C---          Step "out" to find a point closer to the critical value.
              RANHALF = ABS( RANHALF ) * 0.5
C
C---          The data is ASSUMED to hit:  Copy the data for a 
C---          "hit" to the data file.  
C---          NOTE ASSUMPTION:  Always step out from 'miss' and 
C---          in after a 'hit'. (oked with XR - 14 APR 91)
C---          This code was taken out of the loop under XR97:
C---          All trajecotries need to be wriiten to the IMPACT.ASC 
C---          even for complete miss trajectories, thus is this code 
C---          was moved outside this IF loop
C              NDATA = 1
C              CALL SWP_7DATA( NDATA )
C
          ENDIF
C
      ENDIF
C
C---  Write the data to the IMPACT.ASC file whether it was a "hit" or 
C---  "miss"
C     
C---  Comment out this CALL so that all impact data will be written
C---  from IMPACT7.ASC to IMPACT.ASC at the end of each ray after binary
C---  searches.  This done under XR97
C      NDATA = 1
C      CALL SWP_7DATA( NDATA )
C
C     Calculate the new delta.
C
      RANSAVE = RANSAVE + RANHALF 
C
C     During the binomal search, only keep the most current 
C     trajectory results on BOTH the scratch tapes.
C
C---  Comment out this REWIND so that all impact data will be written
C---  from IMPACT7.ASC to IMPACT.ASC at the end of each ray after binary
C---  searches.  This done under XR97
C      REWIND ( ID_IMPACT7 )
      REWIND ( ID_IMPACT10 )
C
C
C     Go calculate the new trajectory.
C
      RETURN
      END
      SUBROUTINE SWP_INITIO
C
C-------------------------------------------------------------------------
C
C  This module opens the scratch files, opens the sweep output file and 
C  copies the header files to the sweep output.
C
C-------------------------------------------------------------------------
C
      COMMON C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /HCOM/   TITLE
      CHARACTER       TITLE*100  
C
      COMMON /OPPLTC/ ALABLE
      CHARACTER       ALABLE(70)*8
C
C
C***  Input from other modules
C
      EQUIVALENCE (C(2280), NV )

C
      INTEGER   GETENVQQ
      CHARACTER CJUNK8*8, FILENAME*50
      DATA CJUNK8 / '        '/
C
C
C---  Open some scratch files used in the sweep case.
      OPEN( UNIT=ID_IMPACT10, FILE='IMPACT10.ASC', STATUS='UNKNOWN' )
      OPEN( UNIT=ID_IMPACT7,  FILE='IMPACT7.ASC',  STATUS='UNKNOWN' )
C
C     Open the Sweep end data file:
C------------------------PC Code-------------------------------------
C
C---       LENGTH = GETENVQQ( 'IMPACT', FILENAME )
       LENGTH = 0
       IF( LENGTH .EQ. 0 ) FILENAME = 'IMPACT.ASC'
C
      OPEN( UNIT=ID_IMPACT, FILE = FILENAME( 1: LENSTR(FILENAME)), 
     1      STATUS = 'UNKNOWN' )
C
C
C---  On Dec 1994 Dr. Zipfel wanted the option of not creating a traj.bin
C---  Therefore, the title, acronyms and number of acronyms need to be 
C---  obtained from the common variables and the code where the 
C---  information is obtained from the traj.bin file has been commented out.
C
C---  Copy the file title and acronyms from the traj.bin.
C      REWIND ( ID_TRAJBIN )
C      READ(ID_TRAJBIN) TITLE
C---  Set the first character of the title to '1' since the sweep output 
C---  is in ascii
C      TITLE = '1' // TITLE(1:99)
C      WRITE(ID_SWEEP,'(A)' ) TITLE
C      READ(ID_TRAJBIN) IN1, IN2, IN3
C      WRITE(ID_SWEEP,*) IN1, IN2, IN3
C      READ(ID_TRAJBIN) ( ALABLE(I), SPACE, I = 1, NV )
C      WRITE(ID_SWEEP,100) ( ALABLE(I), I = 1, NV )
C  100 FORMAT( 5( A8, 8X ) )
C
C
      REWIND ( ID_IMPACT )
C      
      WRITE(ID_IMPACT,100 ) '1', TITLE  
  100 FORMAT( A, A )    
C      
CCCCCCGAB ADDED NV INPLACE OF C(2280) IN THE FOLLOWING WRITE STATEMENT
      WRITE(ID_IMPACT,110) INT( C(1982) ), INT( C(1983)), NV 
  110 FORMAT( 1X, 3(I2,1X))    
C
CCCCCCGAB ADDED NV INPLACE OF C(2280) IN THE FOLLOWING WRITE STATEMENT  
      WRITE(ID_IMPACT,120) ( ALABLE(J), CJUNK8, J=1, NV )
  120 FORMAT( 5( A8, A8 ) )     
C
C
C---  Rewind the scratch files to insure starting at begining.
      REWIND ( ID_IMPACT10 )
      REWIND ( ID_IMPACT7  )
C
C
      RETURN
      END
      SUBROUTINE SWP_ISEARCH( JGOOD, RANSAVE, RANHALF )
C
C-------------------------------------------------------------------------
C
C  This module sets up the first trajectory in the binary search.  
C
C--Argument List Definitions--------------------------------------------
C
C  INRUNNO - (I) The trajectory number for the inner loop variable.
C  RANSAVE - (R) The inner variable value used in computing the previous 
C            trajectory.
C  RANHALF - (R) The halfed delta; the delta to be used in the binary 
C            search trajectories that will be halfed accordingly.  Also 
C            the delta used in computing the previous trajectory.
C
C--Local Variable Definitions---------------------------------------------
C
C  KRANG    - (I) Pointer into the RDATA array to the inner loop 
C             variable value.
C  KRIT     - (I) Pointer into the RDATA array to the critical data 
C             value produced by the trajectory.
C  NV10     - (I) The number of variables written to the scratch file by 
C             module STGE3.  The max number of variables in RDATA.
C  RDATA(3) - (R) The final trajectory data written to scratch by module 
C             STGE3.  This data contains the criteria data value, the 
C             inner variable and the outer variable for that trajectory.
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C***  Input
C
      EQUIVALENCE (C(1824), RANDEL )
C
C RANDEL = The delta for the inner variable.
C
C
      DIMENSION RDATA(3)
C
C     DATA  KRIT/ 1 /                    ! Not used in this module.
      DATA   KRANG/ 2 /, NV10/ 3 /
C
C
C---  Rewind the scratch file and read to the data that generated 
C---  the good trajectory.  
      REWIND ( ID_IMPACT10 )
      DO I = 1, JGOOD
         READ(ID_IMPACT10,*, END= 1140 ) (RDATA(J), J=1, NV10 )
      ENDDO
C
C
C---  Transfer the plot variable data from the scratch file 7 to the 
C---  IMPACT7.
C---  Comment out this CALL so that all impact data will be written
C---  from IMPACT7.ASC to IMPACT.ASC at the end of each ray after binary
C---  searches.  This done under XR97
C      CALL SWP_7DATA( JGOOD )
C
C
C
 1140 CONTINUE
C
C
C---  Rewind the scratch files for the start of:
C---  either the next ray data, or the search data.
C
      REWIND (ID_IMPACT10) 
C---  Comment out this REWIND so that all impact data will be written
C---  from IMPACT7.ASC to IMPACT.ASC at the end of each ray after binary
C---  searches.  This done under XR97
C      REWIND (ID_IMPACT7)
C
C
C---  Setup the first trajectory for the binary search methodology.  
C     Half the inner variable increment.
C
      RANHALF = RANDEL * 0.5
C
C     Get the last initial inner variable value that produced a 
C     trajectory that satisfied the criteria.
C     Remember - in the above read statements, RDATA was loaded 
C     with the JGOODth trajectory data.
C 
      RANSAVE = RDATA( KRANG ) 
C
C     Compute the range for the next trajectory.  This is found from the 
C     range that satisfied the criteria, then adding the new increment.
C
      RANSAVE = RANSAVE + RANHALF
C
C
      RETURN
      END
      SUBROUTINE SWP_ISEARCH5( IBOUND, JGOOD, RANSAVE, RANHALF )
C
C-------------------------------------------------------------------------
C
C  This module sets up the first trajectory in the binary search for 
C  SWEEP mode 5.
C
C--Argument List Definitions--------------------------------------------
C
C  IBOUND   - (I) The boundary for which the searches will try to locate:
C             Boundary 1:  Inner Boundary or Second hole/bayou boundary
C             Boundary 2:  Hole or Bayou
C  JGOOD - (I) The trajectory number that produced a non-zero PCA.
C  RANSAVE - (R) The inner variable value used in computing the previous 
C            trajectory.
C  RANHALF - (R) The halfed delta; the delta to be used in the binary 
C            search trajectories that will be halfed accordingly.  Also 
C            the delta used in computing the previous trajectory.
C
C--Local Variable Definitions---------------------------------------------
C
C  KRANG    - (I) Pointer into the RDATA array to the inner loop 
C             variable value.
C  KRIT     - (I) Pointer into the RDATA array to the critical data 
C             value produced by the trajectory.
C  NV10     - (I) The number of variables written to the scratch file by 
C             module STGE3.  The max number of variables in RDATA.
C  RDATA(3) - (R) The final trajectory data written to scratch by module 
C             STGE3.  This data contains the criteria data value, the 
C             inner variable and the outer variable for that trajectory.
C
C-------------------------------------------------------------------------
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C***  Input
C
      EQUIVALENCE (C(1824), RANDEL )
      EQUIVALENCE (C(1802), CRITVAL )
C
C CRITVAL = The minimum critical value for the criteria test.
C RANDEL = The delta for the inner variable.
C
C
      DIMENSION RDATA(3)
C
      DATA  KRIT/ 1 /
      DATA  KRANG/ 2 /, NV10/ 3 /
C
C
C---  Rewind the scratch file and read to the data that generated 
C---  the good trajectory.  
      REWIND ( ID_IMPACT10 )
      DO I = 1, JGOOD
         READ(ID_IMPACT10,*, END= 1140 ) (RDATA(J), J=1, NV10 )
      ENDDO
C
C
C---  Transfer the plot variable data from the scratch file 7 to the 
C---  IMPACT7.
C---  Comment out this CALL so that all impact data will be written
C---  from IMPACT7.ASC to IMPACT.ASC at the end of each ray after binary
C---  searches.  This done under XR97
C      CALL SWP_7DATA( JGOOD )
C
C
C
 1140 CONTINUE
C
C
C---  Rewind the scratch files for the start of:
C---  either the next ray data, or the search data.
C
      REWIND (ID_IMPACT10) 
C---  Comment out this REWIND so that all impact data will be written
C---  from IMPACT7.ASC to IMPACT.ASC at the end of each ray after binary
C---  searches.  This done under XR97
C      REWIND (ID_IMPACT7)
C
C
C---  Setup the first trajectory for the binary search methodology.  
C     Half the inner variable increment.
C
      RANHALF = RANDEL * 0.5
C
C     Get the last initial inner variable value that produced a 
C     trajectory that satisfied the criteria.
C     Remember - in the above read statements, RDATA was loaded 
C     with the JGOODth trajectory data.
C 
      RANSAVE = RDATA( KRANG ) 
C
C     Compute the range for the next trajectory.  This is found from the 
C     range that satisfied the criteria, then adding the new increment.
C     Add or subtract according to the boundary number, IBOUND
C         IBOUND = 1 ==> Subtract half delta
C         IBOUND = 2 ==> Add half delta
C
      IF( IBOUND .EQ. 1 ) THEN
C
C         Check direction of half delta based on value of critical variable
          IF( RDATA(KRIT) .LT. CRITVAL ) THEN
              RANSAVE = RANSAVE - RANHALF
          ELSE
              RANSAVE = RANSAVE + RANHALF
          ENDIF
C
      ELSEIF( IBOUND .EQ. 2 ) THEN
C
C         Check direction of half delta based on value of critical variable
          IF( RDATA(KRIT) .GT. CRITVAL ) THEN
              RANSAVE = RANSAVE - RANHALF
          ELSE
              RANSAVE = RANSAVE + RANHALF
          ENDIF
C
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE SWP_NEXTOV( INRUNNO, OUTRUNNO, ANGSAVE )
C
C-------------------------------------------------------------------------
C
C  This module increments the outer variable, rewinds all scratch files
C  and sets the flags for the first trajectory in the next ray and
C  checks the outer variable for the end of the runs.
C
C--Argument List Definition---------------------------------------------
C
C  INRUNNO  - (I) The counter for the inner variable trajectories.
C  OUTRUNNO - (I) The counter for the outer variable.
C  ANGSAVE  - (R) The current value for the outer variable.
C
C-------------------------------------------------------------------------
C
      INTEGER  OUTRUNNO
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C***  Input
C
      EQUIVALENCE (C(1813), ANGMAX )
      EQUIVALENCE (C(1814), ANGDEL )
C
C ANGMAX = The maximum value for the outer variable.
C ANGDEL = The delta for the outer variable.
C
C
C---  Rewind all scratch files for the next ray.
      REWIND ID_IMPACT7
      REWIND ID_IMPACT10     ! Restart the criteria tape.
C
C---  Increment the outer variable.
      ANGSAVE = ANGSAVE + ANGDEL 
C
C---  Test the outer loop variable against the max value input 
C---  by the user.
      IF( ANGSAVE .LE. ANGMAX ) THEN 
C
C         Have not reached the maximum outer loop variable. 
C         Initialize variables for the new ray calculations.
C
          OUTRUNNO = OUTRUNNO + 1
C
C         Reset the inner loop counter
C
          INRUNNO  = 0
C
      ELSE
C
C         Finished all trajectories - perform shutdown 
C         prodecures.
C
          CALL SWP_END
C
      ENDIF
C
C
      RETURN
      END
      SUBROUTINE SWP_RUNINIT( INRUNNO, OUTRUNNO, ANGSAVE )
C
C-------------------------------------------------------------------------
C
C  This module initializes flags for counting the trajectories and 
C  opens the output files.
C
C--Argument List Definition---------------------------------------------
C
C  INRUNNO - (I) Counter for the inner loop trajectories.
C  OUTRUNNO - (I) Counter for the outer loop trajectories.
C  ANGSAVE - (R)  The saved value of the outer variable used in the last 
C            calculated trajectories.
C
C-------------------------------------------------------------------------
C
      INTEGER  OUTRUNNO
C
C
      COMMON  C(3510)
C
C***  Input
C
      EQUIVALENCE (C(1812), ANGMIN )
C
C
C     First time through the sweep algorithm
C
      OUTRUNNO = 1
      INRUNNO = 0
C
C     Initialize the I/O files.
C
      CALL SWP_INITIO
C
C     Save the outer loop variable for this trajectory.
C
      ANGSAVE = ANGMIN
C         
C
      RETURN
      END
      SUBROUTINE SWEEP0_METHOD
C
C-------------------------------------------------------------------------
C
C  This module contains the controlling methodology for the CADAC 
C  Sweep option 0.   In this method, NUMR trajectories are calculated 
C  at equally spaced intervals between the minimum and maximum values for 
C  the inner variable.  (NUMR is entered by the user)   NO criteria 
C  checking is performed in this option.
C
C  TASK XR97:
C    Under this task, the program was modified to check the CRITMAX value
C    If this value was not set using the CADIN.ASC file, set it to 
C    CRITVAL + 9.0E+05
C
C  TASK XR92:  
C    Under this task, the program was modified to allow multi-run/Monte-
C    Carlo option and Sweeps option selected in the same input deck.  When 
C    this occurs then allow the increment of the range and angle variables 
C    to occur only when JRUN = 1.  For other values of JRUN, the
C    same angle and range are to be used until the number of runs for 
C    the "sweep group" have been completed.  Be careful - If the type 5
C    card is omitted from the input deck, the range and angle must still 
C    be incremented for each (JRUN) trajectory.
C   
C
C-------------------------------------------------------------------------
C
C  INRUNNO  - (I) The run number for the inner loop variable.
C  OUTRUNNO - (I) The counter for the outer loop variable.
C  RANSAVE  - (R) The range(inner variable value) for the current 
C             trajectory
C  ANGSAVE  - (R) The angle(outer variable value) for the current 
C             trajectory.
C 
C-------------------------------------------------------------------------
C
      INTEGER OUTRUNNO
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /KRUN/   JRUN, MULRUN, IGROUP
C
C
C***  Input
C
      EQUIVALENCE (C(1804), NUMR   )
      EQUIVALENCE (C(1811), ANGLNO )
      EQUIVALENCE (C(1821), RANGNO )
      EQUIVALENCE (C(1822), RANMIN )
      EQUIVALENCE (C(1823), RANMAX )
C
C NUMR =   The number of trajectories to be generated per ray.
C ANGLNO = The C element number for the outer variable.
C RANGNO = The C element number for the inner variable.
C RANMIN = The minimum value for the inner variable.
C RANMAX = The maximum value for the inner variable.
C
C---  Remember:  Ransave and Angsave are local to this module and will 
C---  contain the same values upon return to this module 
C
C
      IF( MULRUN .GT. 0  .AND. JRUN .NE. 1 ) THEN 
C   
C---    This is a multi-run/MonteCarlo sweep case.  A type 5 card
C---    and sweep cards are included on the same deck.  
C
C---    However - This particular trajectory is one of a group of 
C---    trajectories.  It is not the FIRST of the group since Jrun is
C---    greater than 1.  Insure that the data generated by previously
C---    trajectories is printed to the IMPACT.ASC file.
        NDATA = 1
        CALL SWP_7DATA( NDATA )
C
C  
      ELSE 
C
C   
C---    Two instances have occurred:
C---      1) A SINGLE Sweep case is being executed (ie. Monte-Carlo
C---         /multi-run cases are NOT being executed with Sweep - 
C---         the type 5 card was omitted from the input deck)
C---      2) Multi-runs/Monte-Carlo and Sweep are being executed in 
C---         the same input deck AND This is the first trajectory for 
C---         this `Sweep group' and the range and angle need to be set.
C
        IF( OUTRUNNO .LT. 1 ) THEN 
C
C---      First time through the sweep algorithm - init flags:
          CALL SWP_RUNINIT( INRUNNO, OUTRUNNO, ANGSAVE )
C
          IF( NUMR .LT. 1 ) THEN 
C
C---        Only 1 trajectory was requested.
            WRITE(ID_TABOUT,*) 
            WRITE(ID_TABOUT,*)' *** OPTION0 SWP1 ERROR -  NUMR <= 0 ***'
            WRITE(ID_TABOUT,*)'    PROGRAM EXECUTION STOPPED '
            WRITE(ID_TABOUT,*) 
C
            CALL SWP_END
C            
          ENDIF
C
        ELSE
C
C---      Time to setup first trajectory for the next outer variable 
C---      value.  But first - Print the last trajectory plot data 
C---      to the file.
          NDATA = 1
          CALL SWP_7DATA( NDATA )
C
        ENDIF
C
C
  100   CONTINUE
C
C---    Set the maximum critical variable, CRITMAX
        CALL SWP_CRITCHECK
C
        IF(  INRUNNO .LT. 1 ) THEN 
C
C---      The first trajectory for the inner variable.
C---      Calculate the delta range for the increment.  Since the C 
C---      array is zeroed at the start of each trajectory, don't save 
C---      this in the RANDEL location.  Save it in a local variable.
          IF( NUMR .LT. 2 ) THEN 
C
C---        Only one trajectory is requested.  Set the delta to 
C---        a value larger than the maximum range.
            SRANDEL = RANMAX + 100
C
          ELSEIF( NUMR .LT. 3 ) THEN 
C
C---        Numr = 2 :  Special case and SRANDEL calculation fails
C---        to provide the correct value.  Set the SRANDEL to provide
C---        a trajectory at each endpoint.
            SRANDEL = RANMAX - RANMIN
C
          ELSE
C
C---        Multiple trajectories - calculate the delta.
            SRANDEL = ( RANMAX - RANMIN ) / ( NUMR - 1 )
C            
          ENDIF
C
C---      Save the inner loop variable value for this trajectory. 
          RANSAVE = RANMIN
C
C
        ELSE
C
          IF( INRUNNO .LT. NUMR  ) THEN 
C
C---        Not finished with runs along this ray. Increment inner variable.
            RANSAVE = RANSAVE + SRANDEL
C
          ELSE
C
C---        Finished the trajectories for the inner variable. 
C---        Increment the local variables for the next trajectory.  
            CALL SWP_NEXTOV( INRUNNO, OUTRUNNO, ANGSAVE )
C
            GOTO 100
C            
          ENDIF
C
C
        ENDIF
C
C---    Increment the inner variable counter.
        INRUNNO = INRUNNO + 1
C
      ENDIF
C
C---  End of check for single sweep or first sweep of a group
C
C     The new RANSAVE value has been "set".  Set the C location, 
C     perform the requried print to the data file, then go perform 
C     the trajectory calculation.
C
C     Initialize the outer loop variable.  This needs to be 
C     initialized for each trajectory since the C array is zeroed 
C     prior to each trajectory calculation.
C
      C( INT(ANGLNO) ) = ANGSAVE
C
C     Initialize the inner loop element.
C
      C( INT(RANGNO) ) = RANSAVE
C
C     Write the new conditions to the tabular file.
C
      CALL SWP_6PRINT( INRUNNO )
C
C
C     Calculate the trajectory for this initial information.
C
      RETURN
      END
      SUBROUTINE SWEEP1_METHOD
C
C-------------------------------------------------------------------------
C
C  This module contains the controlling methodology for the CADAC 
C  Sweep option 1.   In this method, NUMR trajectories are calculated 
C  at intervals between the minimum and maximum values for the inner 
C  variable.  (NUMR is entered by the user;  NUMR > 3 is recommended)   
C  As the inner loop maximum is reached, the inner loop delta becomes 
C  smaller.  NO criteria checking is performed in this option.
C
C  TASK XR97:
C    Under this task, the program was modified to check the CRITMAX value
C    If this value was not set using the CADIN.ASC file, saet it to 
C    CRITVAL + 9.0E+05
C
C  TASK XR92:  
C    Under this task, the program was modified to allow multi-run/Monte-
C    Carlo option and Sweeps option selected in the same input deck.  When 
C    this occurs then allow the increment of the range and angle variables 
C    to occur only when JRUN = 1.  For other values of JRUN, the
C    same angle and range are to be used until the number of runs for 
C    the "sweep group" have been completed.  Be careful - If the type 5
C    card is omitted from the input deck, the range and angle must still 
C    be incremented for each (JRUN) trajectory.
C   
C
C-------------------------------------------------------------------------
C
C  INRUNNO  - (I) The run number for the inner loop variable.
C  OUTRUNNO - (I) The counter for the outer loop variable.
C  RANSAVE  - (R) The range(inner variable value) for the current 
C             trajectory
C  ANGSAVE  - (R) The angle(outer variable value) for the current 
C             trajectory.
C 
C-------------------------------------------------------------------------
C
      INTEGER OUTRUNNO
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
C
      COMMON /KRUN/   JRUN, MULRUN, IGROUP
C
C***  Input
C
      EQUIVALENCE (C(1804), NUMR   )
      EQUIVALENCE (C(1811), ANGLNO )
      EQUIVALENCE (C(1821), RANGNO )
      EQUIVALENCE (C(1822), RANMIN )
      EQUIVALENCE (C(1823), RANMAX )
C
C NUMR =   The number of trajectories to be generated per ray.
C ANGLNO = The C element number for the outer variable.
C RANGNO = The C element number for the inner variable.
C RANMIN = The minimum value for the inner variable.
C RANMAX = The maximum value for the inner variable.
C
C---   Remember:  Ransave and Angsave are local to this module and will 
C---   contain the same values upon return to this module 
C
      IF( MULRUN .GT. 0  .AND. JRUN .NE. 1 ) THEN 
C   
C---    This is a multi-run/MonteCarlo sweep case.  A type 5 card
C---    and sweep cards are included on the same deck.  
C---    However - This particular trajectory is one of a group of 
C---    trajectories.  It is not the FIRST of the group since Jrun is
C---    greater than 1.  Insure that the data generated by previously
C---    trajectories is printed to the IMPACT.ASC file.
C
        NDATA = 1
        CALL SWP_7DATA( NDATA )
C
C  
      ELSE 
C
C---    Two instances have occurred:
C---      1) A SINGLE Sweep case is being executed (ie. Monte-Carlo
C---         /multi-run cases are NOT being executed with Sweep - 
C---         the type 5 card was omitted from the input deck)
C---      2) Multi-runs/Monte-Carlo and Sweep are being executed in 
C---         the same input deck AND This is the first trajectory for 
C---         this `Sweep group and the range and angle need to be set.
C
        IF( OUTRUNNO .LT. 1 ) THEN 
C
C---      First time through the sweep algorithm - init flags:
          CALL SWP_RUNINIT( INRUNNO, OUTRUNNO, ANGSAVE )
C
C
          IF( NUMR .LT. 1 ) THEN 
C
C---        No trajectories were selected to be executed!
            WRITE(ID_TABOUT,*) 
            WRITE(ID_TABOUT,*)' *** OPTION1 SWP1 ERROR -  NUMR <= 0 ***'
            WRITE(ID_TABOUT,*)'    PROGRAM EXECUTION STOPPED '
            WRITE(ID_TABOUT,*) 
C
            CALL SWP_END
          ENDIF
C
        ENDIF
C
C
  100   CONTINUE
C
C---    Set the maximum critical value, CRITMAX
        CALL SWP_CRITCHECK
C
        IF(  INRUNNO .LT. 1 ) THEN 
C
C---      The first trajectory for the inner variable.
C---      Insure that the number of trajectories is odd.
          NEWNUMR = NUMR + 2
C
C---      Calculate the mid-point for the inner loop variable:
          RMIDPT = ( RANMAX - RANMIN ) / 2.0
C
C---      Calculate an equation part for the delta-modifying algorithm:
          PARTR1 = (RMIDPT * RMIDPT) * ( 1.0 + ( 2.0 / NEWNUMR ) )
C
C---      Calculate the inner loop variable value for this trajectory. 
          RANSAVE = RANMIN + RMIDPT
C
C---      Since the C array is zeroed at the start of each trajectory, 
C---      don't save this in the RANDEL location.  Save it in a local 
C---      variable.
C---      Calculate the modifying delta for this trajectory:
C
          SRANDEL = RMIDPT
C
C
        ELSEIF( INRUNNO .LT. NUMR ) THEN 
C
C---      Print the previously generated trajectory plot data to the file. 
          NDATA = 1
          CALL SWP_7DATA( NDATA )
C
C---      Not finished with the runs along this ray.
C---      Calculate the next inner variable value 
C
C---      Calculate the modifying delta for this trajectory:
C---      NOTE: This algorithm was used in CADAC for this purpose 
C---      prior to task SEU 9108.
C
          PART3   = 2 * RMIDPT * SRANDEL 
          SRANDEL2 = SRANDEL * SRANDEL 
C
          SRANDEL = RMIDPT + SQRT( PARTR1 + SRANDEL2 - PART3 ) 
C
C---      Calculate the inner loop variable value for this trajectory. 
          RANSAVE = RANMIN + SRANDEL 
C
C
        ELSE
C
C---      Print the previously generated trajectory plot data to 
C---      the file.
          NDATA = 1
          CALL SWP_7DATA( NDATA )
C
C---      Increment the outer variable.
          CALL SWP_NEXTOV( INRUNNO, OUTRUNNO, ANGSAVE )
C
          GOTO 100
C
        ENDIF
C
C    
C---    Increment the inner variable counter.
        INRUNNO = INRUNNO + 1
C
      ENDIF
C
C
C---  Initialize the outer loop variable.  This needs to be initialized 
C---  for each trajectory since the C array is zeroed prior to each 
C---  trajectory calculation.
      C( INT(ANGLNO) ) = ANGSAVE
C
C---  Initialize the inner loop element.
      C( INT(RANGNO) ) = RANSAVE
C
C---  Write the new conditions to the tabular file.
      CALL SWP_6PRINT( INRUNNO )
C
C
      RETURN
      END
      SUBROUTINE SWEEP2_METHOD
C
C-------------------------------------------------------------------------
C
C  This module contains the controlling methodology for the CADAC 
C  Sweep option 2.   In this method, NUMR trajectories are calculated 
C  at intervals between the minimum and maximum values for the inner 
C  variable.  (NUMR is entered by the user)   As the inner loop maximum is 
C  reached, the inner loop delta becomes larger.  NO criteria 
C  checking is performed in this option.
C
C  TASK XR97:
C    Under this task, the program was modified to check the CRITMAX value
C    If this value was not set using the CADIN.ASC file, saet it to 
C    CRITVAL + 9.0E+05
C
C  TASK XR92:  
C    Under this task, the program was modified to allow multi-run/Monte-
C    Carlo option and Sweeps option selected in the same input deck.  When 
C    this occurs then allow the increment of the range and angle variables 
C    to occur only when JRUN = 1.  For other values of JRUN, the
C    same angle and range are to be used until the number of runs for 
C    the "sweep group" have been completed.  Be careful - If the type 5
C    card is omitted from the input deck, the range and angle must still 
C    be incremented for each (JRUN) trajectory.
C   
C
C-------------------------------------------------------------------------
C
C  INRUNNO  - (I) The run number for the inner loop variable.
C  OUTRUNNO - (I) The counter for the outer loop variable.
C  RANSAVE  - (R) The range(inner variable value) for the current 
C             trajectory
C  ANGSAVE  - (R) The angle(outer variable value) for the current 
C             trajectory.
C 
C-------------------------------------------------------------------------
C
      INTEGER OUTRUNNO
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /KRUN/   JRUN, MULRUN, IGROUP
C
C
C***  Input
C
      EQUIVALENCE (C(1804), NUMR   )
      EQUIVALENCE (C(1811), ANGLNO )
      EQUIVALENCE (C(1821), RANGNO )
      EQUIVALENCE (C(1822), RANMIN )
      EQUIVALENCE (C(1823), RANMAX )
C
C NUMR =   The number of trajectories to be generated per ray.
C ANGLNO = The C element number for the outer variable.
C RANGNO = The C element number for the inner variable.
C RANMIN = The minimum value for the inner variable.
C RANMAX = The maximum value for the inner variable.
C
C---   Remember:  Ransave and Angsave are local to this module and will 
C---   contain the same values upon return to this module 
C
C  
      IF( MULRUN .GT. 0  .AND. JRUN .NE. 1 ) THEN 
C   
C---    This is a multi-run/MonteCarlo sweep case.  A type 5 card
C---    and sweep cards are included on the same deck.  
C
C---    However - This particular trajectory is one of a group of 
C---    trajectories.  It is not the FIRST of the group since Jrun is
C---    greater than 1.  Insure that the data generated by previously
C---    trajectories is printed to the IMPACT.ASC file.
        NDATA = 1
        CALL SWP_7DATA( NDATA )
C
C  
      ELSE 
C
C       Two instances have occurred:
C---      1) A SINGLE Sweep case is being executed (ie. Monte-Carlo
C---         /multi-run cases are NOT being executed with Sweep - 
C---         the type 5 card was omitted from the input deck)
C---      2) Multi-runs/Monte-Carlo and Sweep are being executed in 
C---         the same input deck AND This is the first trajectory for 
C---         this `Sweep group and the range and angle need to be set.
C---
C
        IF( OUTRUNNO .LT. 1 ) THEN 
C
C---      First time through the sweep algorithm - init flags:
          CALL SWP_RUNINIT( INRUNNO, OUTRUNNO, ANGSAVE )
C
          IF( NUMR .LT. 1 ) THEN 
C
C---        No trajectories were selected to be executed!
            WRITE(ID_TABOUT,*) 
            WRITE(ID_TABOUT,*)' *** OPTION2 SWP1 ERROR -  NUMR <= 0 ***'
            WRITE(ID_TABOUT,*)'    PROGRAM EXECUTION STOPPED '
            WRITE(ID_TABOUT,*) 
C
            CALL SWP_END
C
          ENDIF
C
        ENDIF
C
C
  100   CONTINUE
C
C---    Set the maximum critical value, CRITMAX
        CALL SWP_CRITCHECK
C
        IF(  INRUNNO .LT. 1 ) THEN 
C
C---      The first trajectory for the inner variable. Modify the
C---      number to obtain the requested number of trajectories. 
          NEWNUMR = NUMR + 2 
C
C---      Calculate the mid-point for the inner loop variable:
          RMIDPT = ( RANMAX - RANMIN ) / 2.0
C
C---      Calculate the number of runs to the midpoint:
          MIDRUN = ( NEWNUMR + 1 ) / 2
C
C---      Calculate a part of the delta-modifying algorithm:
          PARTR2 = (RMIDPT * RMIDPT) * ( 1.0 -( 2.0 / NEWNUMR ) )
C
C---      Since the C array is zeroed at the start of each trajectory, 
C---      don't save this in the RANDEL location.  Save it in a local 
C---      variable.                                         
C
C---      Calculate the modifying delta for this trajectory:
          SRANDEL = 0.0
C
C---      Calculate the inner loop variable value for this trajectory. 
          RANSAVE = RANMIN 
C
C
        ELSEIF( INRUNNO .LT. NUMR  .AND.  INRUNNO .LE. MIDRUN ) THEN 
C
C---      Transfer the previously calculated data
          NDATA = 1
          CALL SWP_7DATA( NDATA )
C
C---      Not finished with the runs along this ray.
C---      Calculate the next inner variable value 
C---      Calculate the modifying delta for this trajectory:
          PART3    = 2 * RMIDPT * SRANDEL 
          SRANDEL2 = SRANDEL * SRANDEL 
          SQVALUE  = PARTR2 + SRANDEL2 - PART3
C
C---      Careful - cant take square root of 0:
C
          IF( SQVALUE .GT. 0.0 ) THEN 
C
C---        Value not yet zero - can take square root:
            SRANDEL = RMIDPT - SQRT( SQVALUE ) 
C            
          ELSE
C
C---        Reached the midpoint  
            SRANDEL = RMIDPT
C            
          ENDIF
C
C---      Calculate the inner loop variable value for this trajectory. 
          RANSAVE = RANMIN + SRANDEL
C
C
        ELSE
C
C---      Transfer the previously calculated data
          NDATA = 1
          CALL SWP_7DATA( NDATA )
C
          CALL SWP_NEXTOV( INRUNNO, OUTRUNNO, ANGSAVE )
C
          GOTO 100
C
        ENDIF
C    
C    
C---    Increment the inner variable counter.
        INRUNNO = INRUNNO + 1
C
      ENDIF
C
C---  Initialize the outer loop variable.  This needs to be initialized 
C---  for each trajectory since the C array is zeroed prior to each 
C---  trajectory calculation.
      C( INT(ANGLNO) ) = ANGSAVE
C
C---  Initialize the inner loop element.
      C( INT(RANGNO) ) = RANSAVE
C
C---  Write the new conditions to the tabular file.
      CALL SWP_6PRINT( INRUNNO )
C
C
      RETURN
      END
      SUBROUTINE SWEEP3_METHOD
C
C-------------------------------------------------------------------------
C
C  This module contains the controlling methodology for the CADAC 
C  Sweep option 3.   In this method, NUMR trajectories are calculated 
C  at intervals between the minimum and maximum values for the inner 
C  variable.  (NUMR is entered by the user)   This methodology uses a 
C  small inner variable delta near the  minimum and maximum values and a 
C  larger delta near the midpoint.  NO criteria checking is performed in 
C  this option.
C
C  TASK XR97:
C    Under this task, the program was modified to check the CRITMAX value
C    If this value was not set using the CADIN.ASC file, saet it to 
C    CRITVAL + 9.0E+05
C
C  TASK XR92:  
C    Under this task, the program was modified to allow multi-run/Monte-
C    Carlo option and Sweeps option selected in the same input deck.  When 
C    this occurs then allow the increment of the range and angle variables 
C    to occur only when JRUN = 1.  For other values of JRUN, the
C    same angle and range are to be used until the number of runs for 
C    the "sweep group" have been completed.  Be careful - If the type 5
C    card is omitted from the input deck, the range and angle must still 
C    be incremented for each (JRUN) trajectory.
C   
C
C-------------------------------------------------------------------------
C
C  INRUNNO  - (I) The run number for the inner loop variable.
C  OUTRUNNO - (I) The counter for the outer loop variable.
C  RANSAVE  - (R) The range(inner variable value) for the current 
C             trajectory
C  ANGSAVE  - (R) The angle(outer variable value) for the current 
C             trajectory.
C 
C-------------------------------------------------------------------------
C
      INTEGER OUTRUNNO
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /KRUN/   JRUN, MULRUN, IGROUP
C
C
C***  Input 
C
      EQUIVALENCE (C(1804), NUMR   )
      EQUIVALENCE (C(1811), ANGLNO )
      EQUIVALENCE (C(1821), RANGNO )
      EQUIVALENCE (C(1822), RANMIN )
      EQUIVALENCE (C(1823), RANMAX )
C
C NUMR =   The number of trajectories to be generated per ray.
C ANGLNO = The C element number for the outer variable.
C RANGNO = The C element number for the inner variable.
C RANMIN = The minimum value for the inner variable.
C RANMAX = The maximum value for the inner variable.
C
C---   Remember:  Ransave and Angsave are local to this module and will 
C---   contain the same values upon return to this module 
C
C  
      IF( MULRUN .GT. 0  .AND. JRUN .NE. 1 ) THEN 
C   
C---      This is a multi-run/MonteCarlo sweep case.  A type 5 card
C---      and sweep cards are included on the same deck.  
C
C---      However - This particular trajectory is one of a group of 
C---      trajectories.  It is not the FIRST of the group since Jrun is
C---      greater than 1.  Insure that the data generated by previously
C---      trajectories is printed to the IMPACT.ASC file.
C
          NDATA = 1
          CALL SWP_7DATA( NDATA )
C
C  
      ELSE 
C
C   
C         Two instances have occurred:
C           1) A SINGLE Sweep case is being executed (ie. Monte-Carlo
C              /multi-run cases are NOT being executed with Sweep - 
C              the type 5 card was omitted from the input deck)
C           2) Multi-runs/Monte-Carlo and Sweep are being executed in 
C              the same input deck AND This is the first trajectory for 
C              this `Sweep group and the range and angle need to be set.
C
C
          IF( OUTRUNNO .LT. 1 ) THEN 
C
C             First time through the sweep algorithm - init flags:
C
              CALL SWP_RUNINIT( INRUNNO, OUTRUNNO, ANGSAVE )
C
C
              IF( NUMR .LT. 1 ) THEN 
C
C                 No trajectories were selected to be executed!
C              
                  WRITE(ID_TABOUT,*) 
                  WRITE(ID_TABOUT,*)
     1              ' *** OPTION3 SWP1 ERROR -  NUMR <= 0 ***'
                  WRITE(ID_TABOUT,*) '    PROGRAM EXECUTION STOPPED '
                  WRITE(ID_TABOUT,*) 
C
                  CALL SWP_END
C
              ENDIF
C
          ENDIF
C
C
  100     CONTINUE
C
C---      Set the maximum critical value
          CALL SWP_CRITCHECK
C
          IF(  INRUNNO .LT. 1 ) THEN 
C
C              The first trajectory for the inner variable.
C              Calculate the integer required to calculate the 
C              smaller -> larger deltas
C
               NEWNUMR = NUMR + 2
C
C              Calculate the mid-point for the inner loop variable:
C
               RMIDPT = ( RANMAX - RANMIN ) / 2.0
C
C              Calculate the number of runs to the midpoint:
C
               MIDRUN = ( NUMR + 1 ) / 2
C
C              Calculate the factors for the delta-modifying algorithm:
C
               PARTR1 = (RMIDPT * RMIDPT) * ( 1.0 +( 2.0 / NEWNUMR ) )
               PARTR2 = (RMIDPT * RMIDPT) * ( 1.0 -( 2.0 / NEWNUMR ) )
C
C              Since the C array is zeroed at the start of each trajectory, 
C              don't save this in the RANDEL location.  Save it in a local 
C              variable.
C              Calculate the modifying delta for this trajectory:
C
               SRANDEL = 0.0
C
C              Calculate the inner loop variable value for this trajectory. 
C
               RANSAVE = RANMIN 
C
C
          ELSEIF( INRUNNO .LT. NUMR   .AND.  INRUNNO .LT. MIDRUN ) THEN 
C
C              The trajectories prior to the midpoint are being calculated.
C              Transfer the previously calculated data
C
               NDATA = 1
               CALL SWP_7DATA( NDATA )
C
C              Not finished with the runs along this ray.
C              Calculate the next inner variable value
C
C              Previous inner variable was less than the midpoint.  
C              Use the algorithm for increasing deltas.
C
               PART3 = 2 * RMIDPT * SRANDEL 
               SRANDEL2 = SRANDEL * SRANDEL 
               SQVALUE = PARTR2 + SRANDEL2 - PART3
C
C              Careful - cant take square root of 0:
C
               IF( SQVALUE .GT. 0.0 ) THEN 
C
C                  Value not yet zero - can take square root:
C
                   SRANDEL = RMIDPT - SQRT( SQVALUE ) 
C
               ELSE
C
C                  Reached the midpoint  
C
                   SRANDEL = RMIDPT
C
               ENDIF
C
C              Calculate the inner loop variable value for this trajectory. 
C
               RANSAVE = RANMIN + SRANDEL
C
C
          ELSEIF( INRUNNO .LT. NUMR   ) THEN 
C
C              Calculate the trajectories after the midpoint.
C              Transfer the previously calculated data
C
               NDATA = 1
               CALL SWP_7DATA( NDATA )
C
C              Not finished with the runs along this ray.
C              Calculate the next inner variable value
C
C              Calculate the modifying delta for this trajectory:
C              Previous inner variable was greater than the midpoint
C              Use the algorithm for decreasing deltas.
C
               PART3   = 2 * RMIDPT * SRANDEL 
               SRANDEL2 = SRANDEL * SRANDEL 
C
               SRANDEL = RMIDPT + SQRT( PARTR1 + SRANDEL2 - PART3 ) 
C
C              Calculate the inner loop variable value for this trajectory. 
C
               RANSAVE = RANMIN + SRANDEL
C
          ELSE
C
C              Transfer the previously calculated data
C
               NDATA = 1
               CALL SWP_7DATA( NDATA )
C
               CALL SWP_NEXTOV( INRUNNO, OUTRUNNO, ANGSAVE )
C
               GOTO 100
C
          ENDIF
C
C    
C         Increment the inner variable counter.
C
          INRUNNO = INRUNNO + 1
C
      ENDIF
C
C     Initialize the outer loop variable.  This needs to be initialized 
C     for each trajectory since the C array is zeroed prior to each 
C     trajectory calculation.
C
      C( INT(ANGLNO) ) = ANGSAVE
C
C     Initialize the inner loop element.
C
      C( INT(RANGNO) ) = RANSAVE
C
C     Write the new conditions to the tabular file.
C
      CALL SWP_6PRINT( INRUNNO )
C
C
      RETURN
      END
      SUBROUTINE SWEEP4_METHOD
C
C-------------------------------------------------------------------------
C
C  This module contains the controlling methodology for the CADAC 
C  option 4 sweep cases.  In this methodology, NUMR trajectories are 
C  performed with the criteria results being printed to a scratch file 
C  at the end of each trajectory.  (NUMR is calculated from the 
C  user-entered maximum, minimum and delta for the inner variable.)  
C  The results are then searched in the order from NUMR, NUMR-1, ... 1, 
C  to find the trajectory that produced final data that met the criteria 
C  designated by the user.  This trajectory is then used as a starting 
C  point for a binary search to more closely find the boundary where the 
C  criteria becomes unsatisfied.  The user must specify the number of 
C  trajectories executed during the binary search.
C
C-------------------------------------------------------------------------
C
C  INRUNNO  - (I) The run number for the inner loop variable.
C  NEXTOV   - (L) Flag for incrementing to the next outer loop value. 
C  OUTRUNNO - (I) The counter for the outer loop variable.
C  RANSAVE  - (R) The range(inner variable value) for the current 
C             trajectory
C  ANGSAVE  - (R) The angle(outer variable value) for the current 
C             trajectory.
C 
C-------------------------------------------------------------------------
C
      INTEGER OUTRUNNO
      LOGICAL NEXTOV, GOODAT, NEXTSR
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /KRUN/   JRUN, MULRUN, IGROUP
C
C
C***  Input
C
      EQUIVALENCE (C(1801), CRITNO )
      EQUIVALENCE (C(1803), SEARNO )
      EQUIVALENCE (C(1811), ANGLNO )
      EQUIVALENCE (C(1821), RANGNO )
      EQUIVALENCE (C(1822), RANMIN )
      EQUIVALENCE (C(1823), RANMAX )
      EQUIVALENCE (C(1824), RANDEL )
      EQUIVALENCE (C(1802), CRITVAL)
C
C      SEARNO = The number of trajectories in the binary search 
C      ANGLNO = The C element number for the outer variable.
C      RANGNO = The C element number for the inner variable.
C      RANMIN = The minimum value for the inner variable.
C      RANMAX = The maximum value for the inner variable.
C      RANDEL = The delta for the inner variable.
C
C
      LOGICAL MC_ERR_PRT
      DATA  MC_ERR_PRT/ .FALSE. /
C
C
      CRITVAR = C( INT(CRITNO) )
C
      IF( MULRUN .GT. 0 ) THEN 
C
C         AS OF JULY 1992 (XR92), the determination was made that 
C         Monte-Carlo combined with sweep runs would not produce 
C         a meaningful set of data when used with option 4 of the 
C         sweep methodology.  Perform a check here for Monte-Carlo and 
C         sweep option 4 combinations in the input deck.  If they occur, 
C         print an error message to the TABOUT file and inhibit the 
C         Monte-Carlo option.
C
          IF( .NOT. MC_ERR_PRT  ) THEN 
C
C             NOTE:  only print the error message once.
C
              WRITE(ID_TABOUT,*) 
              WRITE(ID_TABOUT,*)
     1          ' ERROR - TYPE 5 CARD AND SWEEP OPTION 4 IS',
     2          ' AN INVALID COMBINATION ' 
              WRITE(ID_TABOUT,*)' The max number of runs is being reset'
              WRITE(ID_TABOUT,*) 
C
              MC_ERR_PRT = .TRUE.
          ENDIF
C
C         Reset the multi-run max number of trajectories to 0.
C
          MULRUN = 0
      ENDIF
C
C
      IF( OUTRUNNO .LT. 1 ) THEN 
C
C         First time through the sweep algorithm.  Perform the
C         initializaiton module.
C
          CALL SWP_RUNINIT( INRUNNO, OUTRUNNO, ANGSAVE )
C
C         Initialize the flag for incrementing the outer loop:
C
          NEXTOV = .FALSE. 
      ENDIF
C
C
  100 CONTINUE
C
C     Initialize the outer loop variable.  This needs to be initialized 
C     for each trajectory since the C array is zeroed prior to each 
C     trajectory calculation.
C
      C( INT(ANGLNO) ) = ANGSAVE
C
      CALL SWP_CRITCHECK
C
      IF(  INRUNNO .LT. 1 ) THEN 
C
C          The first trajectory for the inner variable.
C          Calculate the number of points between the max and 
C          min with this delta.
C
           NUMR = ( RANMAX - RANMIN ) / RANDEL + 1.0
C
C          Calculate the maximum number of runs for this inner loop;
C          including the number of binary search runs.
C
           NUMRMAX =  NUMR + SEARNO
C
C          Save the inner loop value for this trajectory.
C
           RANSAVE = RANMIN
C
C
      ELSEIF( INRUNNO .LT. NUMR ) THEN 
C
C          Not finished with the runs along this ray.  
C          Increment the inner variable.
C
           RANSAVE = RANSAVE + RANDEL
C
C
      ELSE
C
           IF( INRUNNO .LT. NUMRMAX ) THEN 
C
C              At least 1 binary search has been selected to be
C              executed.  Setup for the next trajectory.
C
               IF( INRUNNO .EQ. NUMR ) THEN 
C
C                  Initial trajectory runs have been completed along a 
C                  constant outer loop variable.  Search the trajectories 
C                  for the first criteria that is satisfied. 
C
                   CALL SWP_FINDMISS( JGOOD, NEXTOV, NEXTSR )
C
C                  If a match was found setup the first binary search.
C
                   IF( .NOT.  NEXTOV ) 
     1                 CALL SWP_ISEARCH( JGOOD, RANSAVE, RANHALF )
C
               ELSE
C
C                  Performing the binary searches. 
C                  2nd or greater trajectory within the binary search.
C
                   CALL SWP_HALFD( RANSAVE, RANHALF ) 
C
               ENDIF
C
C
           ELSE
C
C              Reached the maximum number of binary searches 
C              selected by the user.  
C
               IF( SEARNO .LT. 1 ) THEN 
C
C                  No binary searches were requested.  Copy the 
C                  data from the searches satisfying the criteria to
C                  the tape 22.  So first find the trajectory
C                  satisfying the criteria.
C
                   CALL SWP_FINDMISS( JGOOD, NEXTOV, NEXTSR )
C
C                  Transfer the plot variable data from the scratch 
C                  file 7 to the tape 22 data.
C
C---               Comment out this IF so that all impact data will be written
C---               from IMPACT7.ASC to IMPACT.ASC at the end of each ray after binary
C---               searches.  This done under XR97
c                   IF( .NOT.  NEXTOV ) CALL SWP_7DATA( JGOOD )
C
               ELSE
C
C                   Binary searches were requested and finished.
C                   Check the last search to insure that the
C                   trajectory was correctly completed and data
C                   on the sweep scratch files is the data for this
C                   RANSAVE.  If it is a match AND the data is not a 
C                   miss, transfer the data from file 7 to tape 22
C                   
                    CALL SWP_DATCHK( RANSAVE, GOODAT, CRITDAT )
C
C---                Comment out this CALL so that all impact data will be written
C---                from IMPACT7.ASC to IMPACT.ASC at the end of each ray after binary
C---                searches.  This done under XR97
C                    IF( GOODAT .AND.  ( CRITDAT .GT. CRITVAL ) ) THEN
C                        NDATA = 1
C                        CALL SWP_7DATA( NDATA )
C                    ENDIF
C
               ENDIF
C
C              Set the flag to increment to the next outer variable.
C
               NEXTOV = .TRUE. 
C
           ENDIF
C
C
      ENDIF
C
C
C---  Check to see if the outer variable is to be incremented
C
C
      IF( NEXTOV ) THEN 
C
C         Sort the data on file 7 (IMPACT7.ASC) in ascending range order
C
          CALL SWP_DO_SORT( INRUNNO )
C
C         Reset the flag: 
C
          NEXTOV = .FALSE. 
C
C         Increment to the next outer variable.
C
          CALL SWP_NEXTOV( INRUNNO, OUTRUNNO, ANGSAVE )
C
          GOTO 100
C
      ENDIF
C
C
C     Increment the inner variable counter
C
      INRUNNO = INRUNNO + 1
C
C     Initialize the inner loop element.
C
      C( INT(RANGNO) ) = RANSAVE
C
C     Write the new conditions to the tabular file.
C
      CALL SWP_6PRINT( INRUNNO )
C
C
C     Go calculate the trajectory for these conditions.  
C
      RETURN
      END
      SUBROUTINE SWEEP5_METHOD
C
C-------------------------------------------------------------------------
C
C  This module contains the controlling methodology for the CADAC 
C  option 5 sweep cases.  In this methodology, NUMR trajectories are 
C  performed with the criteria results being printed to a scratch file 
C  at the end of each trajectory.  (NUMR is calculated from the 
C  user-entered maximum, minimum and delta for the inner variable.)  
C  The results are then searched as each trajectory is generated 
C  to find the trajectory that the criteria designated by the user.  
C  This trajectory is then used as a starting point for a binary search to 
C  more closely find the boundary where the criteria becomes unsatisfied.  
C  The user must specify the number of trajectories executed during the 
C  binary search.  After the completion of the binary search, the ray
C  trajectories are then continued from the last ray value.
C  This methodology was added under XR97.
C
C-------------------------------------------------------------------------
C
C  INRUNNO  - (I) The run number for the inner loop variable.
C  NEXTOV   - (L) Flag for incrementing to the next outer loop value. 
C  OUTRUNNO - (I) The counter for the outer loop variable.
C  RANSAVE  - (R) The range(inner variable value) for the current 
C             trajectory
C  ANGSAVE  - (R) The angle(outer variable value) for the current 
C             trajectory.
C  ISEARUN  - (I) The search run number when searching for the boundary
C             where the criteria is unsatisfied
C  LASTRUN  - (I) The run number at which the criteria has been met and the
C             starting point for the boundary binary search.  Once the boundary
C             has been located, this is the starting point to resume the
C             trajectories along the ray
C  IBOUND   - (I) The boundary for which the searches will try to locate:
C             Boundary 1:  Inner Boundary or Second hole/bayou boundary
C             Boundary 2:  Hole or Bayou
C 
C-------------------------------------------------------------------------
C
      INTEGER OUTRUNNO
      LOGICAL NEXTOV, GOODAT, NEXTSR
C
      COMMON  C(3510)
C
      COMMON /FILEIDS/ ID_CADIN,   ID_HEAD,    ID_CSAVE,   ID_TABOUT,
     1                 ID_TRAJBIN, ID_TRAJASC, ID_STATBIN, ID_STATASC,
     2                 ID_RANVAR,  ID_IMPACT,  ID_IMPACT7, ID_IMPACT10,
     3                 ID_INITASC, ID_INITBIN, ID_TRACKASC, ID_TRACKBIN
C
      COMMON /KRUN/   JRUN, MULRUN, IGROUP
C
C
C***  Input
C
      EQUIVALENCE (C(1803), SEARNO )
      EQUIVALENCE (C(1811), ANGLNO )
      EQUIVALENCE (C(1821), RANGNO )
      EQUIVALENCE (C(1822), RANMIN )
      EQUIVALENCE (C(1823), RANMAX )
      EQUIVALENCE (C(1824), RANDEL )
      EQUIVALENCE (C(1802), CRITVAL )
C
C      SEARNO = The number of trajectories in the binary search 
C      ANGLNO = The C element number for the outer variable.
C      RANGNO = The C element number for the inner variable.
C      RANMIN = The minimum value for the inner variable.
C      RANMAX = The maximum value for the inner variable.
C      RANDEL = The delta for the inner variable.
C
C
      LOGICAL MC_ERR_PRT
      DATA  MC_ERR_PRT/ .FALSE. /
C
C
C
      IF( MULRUN .GT. 0 ) THEN 
C
C         AS OF JULY 1992 (XR92), the determination was made that 
C         Monte-Carlo combined with sweep runs would not produce 
C         a meaningful set of data when used with option 4 of the 
C         sweep methodology.  Perform a check here for Monte-Carlo and 
C         sweep option 4 combinations in the input deck.  If they occur, 
C         print an error message to the TABOUT file and inhibit the 
C         Monte-Carlo option.
C
          IF( .NOT. MC_ERR_PRT  ) THEN 
C
C             NOTE:  only print the error message once.
C
              WRITE(ID_TABOUT,*) 
              WRITE(ID_TABOUT,*)
     1          ' ERROR - TYPE 5 CARD AND SWEEP OPTION 4 IS',
     2          ' AN INVALID COMBINATION ' 
              WRITE(ID_TABOUT,*)' The max number of runs is being reset'
              WRITE(ID_TABOUT,*) 
C
              MC_ERR_PRT = .TRUE.
          ENDIF
C
C         Reset the multi-run max number of trajectories to 0.
C
          MULRUN = 0
      ENDIF
C
C
      IF( OUTRUNNO .LT. 1 ) THEN 
C
C         First time through the sweep algorithm.  Perform the
C         initializaiton module.
C
          CALL SWP_RUNINIT( INRUNNO, OUTRUNNO, ANGSAVE )
C
C         Initialize the flag for incrementing the outer loop:
C
          NEXTOV = .FALSE. 
      ENDIF
C
C
  100 CONTINUE
C
C     Initialize the outer loop variable.  This needs to be initialized 
C     for each trajectory since the C array is zeroed prior to each 
C     trajectory calculation.
C
      C( INT(ANGLNO) ) = ANGSAVE
C
      CALL SWP_CRITCHECK
C
      IF(  INRUNNO .LT. 1 ) THEN 
C
C          The first trajectory for the inner variable.
C          Calculate the number of points between the max and 
C          min with this delta.
C
           NUMR = ( RANMAX - RANMIN ) / RANDEL + 1.0
C
C          Calculate the maximum number of runs for this inner loop;
C          including the number of binary search runs.
C
           NUMRMAX =  NUMR + SEARNO
C
C          Save the inner loop value for this trajectory and last run trajectory
C
           RANSAVE = RANMIN
           LASTRUN = RANSAVE
C
C          Initialize the search counter for each boundary binary search
C          Counts from 1 to SEARNO
C
           ISEARUN = 0
C
C          Initialize boundary flag to indicate which boundary to search
C
           IBOUND = 1
C
      ELSEIF( INRUNNO .LT. NUMR ) THEN 
C
           IF ( ISEARUN .LT. 1 ) THEN
C
C              Check to see if the binary search for a boundary needs to be performed
               IF( IBOUND .EQ. 1 ) THEN
C
                   CALL SWP_FINDMISS5( JGOOD, NEXTOV, NEXTSR )
C
               ELSEIF( IBOUND .EQ. 2) THEN
C
	             CALL SWP_FINDMISS( JGOOD, NEXTOV, NEXTSR )
C
	         ENDIF
C
C              Not finished with the runs along this ray.  
C              Increment the inner variable.
C
               IF( .NOT. NEXTSR ) THEN
C
                   RANSAVE = RANSAVE + RANDEL
C
C                  Since data is written to the IMPACT.ASC file at the end of each
C                  trajectory, rewind the IMPACT10.ASC file so that the next trajectory
C                  record can be wriiten to the IMPACT10.ASC file.
                   REWIND( ID_IMPACT10 )
C
               ELSE
C
C                  Setting up first trajectory for binary search
                   LASTRUN = RANSAVE
C
C                  Determine the half delta for searches
                   CALL SWP_ISEARCH5( IBOUND, JGOOD, RANSAVE, RANHALF )
C
C                  New RANSAVE needs to be LASTRUN - RANHALF
CBC                   RANSAVE = LASTRUN - RANHALF
C
C                  Increment the run counters
	             ISEARUN = ISEARUN + 1
                   NUMR = NUMR + 4
                   NUMRMAX = NUMRMAX + 4
C
               ENDIF
C
C              Set the flag to increment the next outer variable
               NEXTOV = .FALSE.
C
	     ELSEIF( ISEARUN .LT. SEARNO ) THEN
C
               IF( IBOUND .EQ. 1 ) THEN
C
                   CALL SWP_HALFD( RANSAVE, RANHALF )
C
               ELSEIF( IBOUND .EQ. 2 ) THEN
C
                   CALL SWP_HALFD5( RANSAVE, RANHALF )
C
               ENDIF
C
C              Increment the run counters
               ISEARUN = ISEARUN + 1
C
C              Set the flag to increment the next outer variable
               NEXTOV = .FALSE.
C
           ELSE
C
C              Reset the run counters
               ISEARUN = 0
C
C              Reset the boundary search flag
               IF( IBOUND .EQ. 1 ) THEN
                   IBOUND = 2
               ELSEIF( IBOUND .EQ. 2 ) THEN
                   IBOUND = 1
               ENDIF
C
C              Set the next inner variable to the next aimpoint after 
C              the binary seach
               RANSAVE = LASTRUN + RANDEL
C
C             Since data is written to the IMPACT.ASC file at the end of each
C             trajectory, rewind the IMPACT10.ASC file so that the next trajectory
C             record can be wriiten to the IMPACT10.ASC file.
              REWIND( ID_IMPACT10 )
C
	     ENDIF
C
      ELSE
C
           IF( INRUNNO .LT. NUMRMAX ) THEN 
C
C              At least 1 binary search has been selected to be
C              executed.  Setup for the next trajectory.
C
               IF( INRUNNO .EQ. NUMR ) THEN 
C
C                  Initial trajectory runs have been completed along a 
C                  constant outer loop variable.  Search the trajectories 
C                  for the first criteria that is satisfied. 
C
                   CALL SWP_FINDMISS( JGOOD, NEXTOV, NEXTSR )
C
C                  If a match was found setup the first binary search.
C
                   IF( .NOT.  NEXTOV ) 
     1                 CALL SWP_ISEARCH( JGOOD, RANSAVE, RANHALF )
C
               ELSE
C
C                  Performing the binary searches. 
C                  2nd or greater trajectory within the binary search.
C
                   CALL SWP_HALFD( RANSAVE, RANHALF ) 
C
               ENDIF
C
C
           ELSE
C
C              Reached the maximum number of binary searches 
C              selected by the user.  
C
               IF( SEARNO .LT. 1 ) THEN 
C
C                  No binary searches were requested.  Copy the 
C                  data from the searches satisfying the criteria to
C                  the tape 22.  So first find the trajectory
C                  satisfying the criteria.
C
                   CALL SWP_FINDMISS( JGOOD, NEXTOV, NEXTSR )
C
C                  Transfer the plot variable data from the scratch 
C                  file 7 to the tape 22 data.
C
                   IF( .NOT.  NEXTOV ) CALL SWP_7DATA( JGOOD )
C
               ELSE
C
C                   Binary searches were requested and finished.
C                   Check the last search to insure that the
C                   trajectory was correctly completed and data
C                   on the sweep scratch files is the data for this
C                   RANSAVE.  If it is a match AND the data is not a 
C                   miss, transfer the data from file 7 to tape 22
C                   
                    CALL SWP_DATCHK( RANSAVE, GOODAT, CRITDAT )
C
               ENDIF
C
C              Set the flag to increment to the next outer variable.
C
               NEXTOV = .TRUE. 
C
           ENDIF
C
C
      ENDIF
C
C
C---  Check to see if the outer variable is to be incremented
C
C
      IF( NEXTOV ) THEN 
C
C         Sort the data on file 7 (IMPACT7.ASC) in ascending range order
C
          CALL SWP_DO_SORT( INRUNNO )
C
C         Reset the flag: 
C
          NEXTOV = .FALSE. 
C
C         Increment to the next outer variable.
C
          CALL SWP_NEXTOV( INRUNNO, OUTRUNNO, ANGSAVE )
C
          GOTO 100
C
      ENDIF
C
C
C     Increment the inner variable counter
C
      INRUNNO = INRUNNO + 1
C
C     Initialize the inner loop element.
C
      C( INT(RANGNO) ) = RANSAVE
C
C     Write the new conditions to the tabular file.
C
      CALL SWP_6PRINT( INRUNNO )
C
C
C     Go calculate the trajectory for these conditions.  
C
      RETURN
      END
      SUBROUTINE LD_MINMAX
C
C-------------------------------------------------------------------------
C
C  This module compares the current data to previous data to find the 
C  minimum/maximum plot values.  The module insures that time is loaded at 
C  the first variable.
C
C--Local Variable Definitions-------------------------------------------
C
C  PRDATA - (R) The array of current data.
C
C-------------------------------------------------------------------------
C
      DIMENSION PRDATA(70)
C
      COMMON         C(3510)
C
      COMMON /OPPLOT/ IPLADD(70), INTPLOT(70)
      LOGICAL         INTPLOT
C
      DIMENSION   IC(3510), PMIN(70)
C
      EQUIVALENCE (C(0001), IC(0001) )
      EQUIVALENCE (C(2127), PMIN(1)  ) 
      EQUIVALENCE (C(2280), NV    )
C
C
C     Force C(2000), TIME, as the first variable
C
      IPLADD(1) = 2000    
C
C     Load the arrays for printing to the plot data file.
C     NV = Number of plot variables
C
      DO I = 1, NV 
C
C        Load the current value of the plot variable
C
         IF( INTPLOT(I) ) THEN
             PRDATA(I) = IC( IPLADD(I) )
         ELSE
             PRDATA(I) = C( IPLADD(I) )  
         ENDIF
C
C        Determine the minimum of the variable compared with the 
C        previous minimum values (and 0 since the C array is initialized 
C        to 0)
C
         PMIN(I) = AMIN1( PRDATA(I), PMIN(I) )
      ENDDO
C
C
      RETURN
      END

C---------------------------------------------------------
C
C     PC Version Code
C
C---------------------------------------------------------
C
      SUBROUTINE STR_UPCASE(LINEIN, LINEOUT)
C
C----------------------------------------------------------------------
C
C     This module converts a string to all uppercase letters.
C
C----------------------------------------------------------------------
C
      CHARACTER*(*) LINEIN, LINEOUT
      INTEGER ASC_VAL
C       
      LINEOUT = LINEIN
      LINE_LEN = LENSTR(LINEOUT)
      DO I = 1, LINE_LEN
        ASC_VAL = ICHAR(LINEOUT(I:I))
        IF( ASC_VAL .GE. 97 .AND. ASC_VAL .LE. 122 ) THEN
          LINEOUT(I:I) = CHAR( ASC_VAL - 32 )
        ENDIF
      ENDDO
C
      RETURN
      END
      FUNCTION LENSTR( THESTRING )
C
C----------------------------------------------------------------------
C
C  This function searches the text contained in the string variable for
C  the end of the text.  The function returns the character location
C  of the last non-blank character location.  This is useful in
C  locating the end of text within a string.  The module will work
C  with any length input string.
C
C----------------------------------------------------------------------
C
C  THESTRING - (C) Input.  The character string to be searched for the
C                  end of the text string.
C
C  LENSTR - (I) The location of the last non-blank character in
C               THESTRING.  A 0 value is returned if the string is
C               completely blank
C
C----------------------------------------------------------------------
C
      CHARACTER*(*) THESTRING
C
      LENGTH = LEN( THESTRING )
C
      DO WHILE ( LENGTH .GT. 0 .AND. THESTRING(LENGTH:LENGTH) .EQ. ' ' )
         LENGTH = LENGTH - 1
      END DO
C
      LENSTR = LENGTH
      RETURN
      END

